peter 24 vuotta sitten
vanhempi
commit
49481a0c63

+ 48 - 17
compiler/ppu.pas

@@ -243,7 +243,7 @@ implementation
                              Endian Handling
 *****************************************************************************}
 
-Function SwapLong(var x : longint): longint;
+Function SwapLong(x : longint): longint;
 var
   y : word;
   z : word;
@@ -256,7 +256,7 @@ Begin
 End;
 
 
-Function SwapWord(var x : word): word;
+Function SwapWord(x : word): word;
 var
   z : byte;
 Begin
@@ -630,14 +630,27 @@ end;
 
 
 procedure tppufile.getsmallset(var b);
+var
+  l : longint;
 begin
-  getdata(b,4);
+  l:=getlongint;
+  longint(b):=l;
 end;
 
 
 procedure tppufile.getnormalset(var b);
+type
+  SetLongintArray = Array [0..7] of longint;
+var
+  i : longint;
 begin
-  getdata(b,32);
+  if change_endian then
+    begin
+      for i:=0 to 7 do
+        SetLongintArray(b)[i]:=getlongint;
+    end
+  else
+    getdata(b,32);
 end;
 
 
@@ -898,22 +911,37 @@ begin
 end;
 
 
-procedure tppufile.putstring(s:string);
-begin
-  putdata(s,length(s)+1);
-end;
+    procedure tppufile.putstring(s:string);
+      begin
+        putdata(s,length(s)+1);
+      end;
 
 
-procedure tppufile.putsmallset(const b);
-begin
-  putdata(b,4);
-end;
+    procedure tppufile.putsmallset(const b);
+      var
+        l : longint;
+      begin
+        l:=longint(b);
+        putlongint(l);
+      end;
 
 
-procedure tppufile.putnormalset(const b);
-begin
-  putdata(b,32);
-end;
+    procedure tppufile.putnormalset(const b);
+      type
+        SetLongintArray = Array [0..7] of longint;
+      var
+        i : longint;
+        tempb : setlongintarray;
+      begin
+        if change_endian then
+          begin
+            for i:=0 to 7 do
+              tempb[i]:=SwapLong(SetLongintArray(b)[i]);
+            putdata(tempb,32);
+          end
+        else
+          putdata(b,32);
+      end;
 
 
     procedure tppufile.tempclose;
@@ -957,7 +985,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.10  2001-06-18 20:36:25  peter
+  Revision 1.11  2001-06-27 21:37:36  peter
+    * v10 merges
+
+  Revision 1.10  2001/06/18 20:36:25  peter
     * -Ur switch (merged)
     * masm fixes (merged)
     * quoted filenames for go32v2 and win32

+ 28 - 5
compiler/ptconst.pas

@@ -65,7 +65,7 @@ implementation
       var
          len,base  : longint;
          p,hp      : tnode;
-         i,l,offset,
+         i,j,l,offset,
          strlength : longint;
          curconstsegment : TAAsmoutput;
          ll        : tasmlabel;
@@ -366,9 +366,29 @@ implementation
                      Message(cg_e_illegal_expression)
                    else
                      begin
-                        { this writing is endian independant }
-                        for l:=0 to t.def.size-1 do
-                          curconstSegment.concat(Tai_const.Create_8bit(tsetconstnode(p).value_set^[l]));
+                        { this writing is endian independant   }
+                        { untrue - because they are considered }
+                        { arrays of 32-bit values CEC          }
+
+                        { store as longint values in little-endian format }
+                        if target_info.endian = endian_little then
+                          begin
+                            for l:= 0 to p.resulttype.def.size-1 do
+                               curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[l]));
+                          end
+                        else
+                          begin
+                            { store as longint values in big-endian format }
+                            j:=0;
+                            for l:=0 to ((p.resulttype.def.size-1) div 4) do
+                              begin
+                                curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[j+3]));
+                                curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[j+2]));
+                                curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[j+1]));
+                                curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[j]));
+                                Inc(j,4);
+                              end;
+                          end;
                      end;
                 end
               else
@@ -885,7 +905,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.24  2001-06-18 20:36:25  peter
+  Revision 1.25  2001-06-27 21:37:36  peter
+    * v10 merges
+
+  Revision 1.24  2001/06/18 20:36:25  peter
     * -Ur switch (merged)
     * masm fixes (merged)
     * quoted filenames for go32v2 and win32

+ 5 - 12
compiler/symdef.pas

@@ -2335,20 +2335,11 @@ implementation
                                    TSETDEF
 ***************************************************************************}
 
-{ For i386 smallsets work,
-  for m68k there are problems
-  can be test by compiling with -dusesmallset PM }
-{$ifdef i386}
-{$define usesmallset}
-{$endif i386}
-
     constructor tsetdef.create(const t:ttype;high : longint);
       begin
          inherited create;
          deftype:=setdef;
          elementtype:=t;
-{$ifdef usesmallset}
-         { small sets only working for i386 PM }
          if high<32 then
            begin
             settype:=smallset;
@@ -2363,8 +2354,7 @@ implementation
               ;
           end
          else
-{$endif usesmallset}
-         if high<256 then
+          if high<256 then
            begin
               settype:=normset;
               savesize:=32;
@@ -5524,7 +5514,10 @@ Const local_symtable_index : longint = $8001;
 end.
 {
   $Log$
-  Revision 1.34  2001-06-04 18:05:39  peter
+  Revision 1.35  2001-06-27 21:37:36  peter
+    * v10 merges
+
+  Revision 1.34  2001/06/04 18:05:39  peter
     * procdef demangling fixed
 
   Revision 1.33  2001/06/04 11:53:13  peter

+ 0 - 4
rtl/beos/Makefile

@@ -126,12 +126,8 @@ PROCINC=$(RTL)/$(CPU_TARGET)
 UNIXINC=$(RTL)/unix
 UNITPREFIX=rtl
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 override TARGET_UNITS+=system objpas strings beos dos sysutils typinfo math varutils cpu mmx getopts heaptrc lineinfo

+ 0 - 4
rtl/beos/Makefile.fpc

@@ -42,12 +42,8 @@ UNITPREFIX=rtl
 # that generates release PPU files
 # which will not be recompiled
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 
 # Paths
 OBJPASDIR=$(RTL)/objpas

+ 4 - 2
rtl/freebsd/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by fpcmake v1.99.0 [2001/06/06]
+# Don't edit, this file is generated by fpcmake v1.99.0 [2001/06/10]
 #
 default: all
 override PATH:=$(subst \,/,$(PATH))
@@ -58,7 +58,6 @@ else
 BASEDIR=.
 endif
 override OS_TARGET=freebsd
-override CPU_TARGET=i386
 ifndef FPC
 ifdef PP
 FPC=$(PP)
@@ -135,6 +134,9 @@ LINUXUNIT=linux
 override FPCOPT+=-dUNIX
 PRT0=prt0_10
 endif
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 ifndef USELIBGGI

+ 0 - 4
rtl/freebsd/Makefile.fpc

@@ -63,12 +63,8 @@ endif
 # that generates release PPU files
 # which will not be recompiled
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 
 # Paths
 OBJPASDIR=$(RTL)/objpas

+ 0 - 4
rtl/go32v1/Makefile

@@ -124,12 +124,8 @@ RTL=..
 INC=../inc
 PROCINC=../$(CPU_TARGET)
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 SYSTEMUNIT=system

+ 0 - 4
rtl/go32v1/Makefile.fpc

@@ -40,12 +40,8 @@ PROCINC=../$(CPU_TARGET)
 # that generates release PPU files
 # which will not be recompiled
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 
 # Paths
 OBJPASDIR=$(RTL)/objpas

+ 0 - 4
rtl/go32v2/Makefile

@@ -125,12 +125,8 @@ INC=../inc
 PROCINC=../$(CPU_TARGET)
 UNITPREFIX=rtl
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 ifdef EXCEPTIONS_IN_SYSTEM

+ 0 - 4
rtl/go32v2/Makefile.fpc

@@ -44,12 +44,8 @@ UNITPREFIX=rtl
 # that generates release PPU files
 # which will not be recompiled
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 
 # Paths
 OBJPASDIR=$(RTL)/objpas

+ 7 - 2
rtl/inc/file.inc

@@ -380,7 +380,9 @@ Begin
   If FileRec(f).mode=fmClosed Then
    Begin
      Do_Rename(PChar(@FileRec(f).Name),p);
-     Move(p^,FileRec(f).Name,StrLen(p)+1);
+     { check error code of do_rename }
+     If InOutRes = 0 then
+        Move(p^,FileRec(f).Name,StrLen(p)+1);
    End;
 End;
 
@@ -410,7 +412,10 @@ End;
 
 {
   $Log$
-  Revision 1.3  2001-06-04 11:43:51  peter
+  Revision 1.4  2001-06-27 21:37:38  peter
+    * v10 merges
+
+  Revision 1.3  2001/06/04 11:43:51  peter
     * Formal const to var fixes
     * Hexstr(int64) added
 

+ 37 - 33
rtl/inc/genset.inc

@@ -15,21 +15,22 @@
  **********************************************************************}
 
  TYPE
-   TNormalSet = array[0..31] of byte;
+   { TNormalSet = array[0..31] of byte;}
+    TNormalSet = array[0..7] of longint;
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
-{$Error No pascal version of FPC_SET_LOAD_SMALL}
- { THIS DEPENDS ON THE ENDIAN OF THE ARCHITECTURE! }
+{ Error No pascal version of FPC_SET_LOAD_SMALL}
+ { THIS DEPENDS ON THE ENDIAN OF THE ARCHITECTURE!
+   Not anymore PM}
 
-{ procedure do_load_small(p : pointer;l:longint);[public,alias:'FPC_SET_LOAD_SMALL'];}
+procedure do_load_small(p : pointer;l:longint);[public,alias:'FPC_SET_LOAD_SMALL'];
  {
   load a normal set p from a smallset l
  }
-{ begin
-   for i:=0 to 3 do
-    TNormalSet(p^)[i] := l shr (8*i);
-   RunError(255);
- end;}
+ begin
+   Fillchar(p^,SizeOf(TNormalSet),#0);
+   TNormalSet(p^)[0] := l;
+ end;
 {$endif FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
 
 
@@ -39,8 +40,8 @@
   create a new set in p from an element b
  }
  begin
-   Fillchar(p^,32,#0);
-   TNormalSet(p^)[b div 8] := 1 shl (b mod 8);
+   Fillchar(p^,SizeOf(TNormalSet),#0);
+   TNormalSet(p^)[b div 32] := 1 shl (b mod 32);
  end;
 {$endif FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
 
@@ -50,11 +51,11 @@
   add the element b to the set pointed by p
  }
   var
-   c: byte;
+   c: longint;
   begin
-    c := TNormalSet(p^)[b div 8];
-    c := (1 shl (b mod 8)) or c;
-    TNormalSet(p^)[b div 8] := c;
+    c := TNormalSet(p^)[b div 32];
+    c := (1 shl (b mod 32)) or c;
+    TNormalSet(p^)[b div 32] := c;
   end;
 {$endif FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
 
@@ -66,11 +67,11 @@
    used for exclude(set,element)
  }
   var
-   c: byte;
+   c: longint;
   begin
-    c := TNormalSet(p^)[b div 8];
-    c := c and not (1 shl (b mod 8));
-    TNormalSet(p^)[b div 8] := c;
+    c := TNormalSet(p^)[b div 32];
+    c := c and not (1 shl (b mod 32));
+    TNormalSet(p^)[b div 32] := c;
   end;
 {$endif FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
 
@@ -82,13 +83,13 @@
  }
   var
    i: integer;
-   c: byte;
+   c: longint;
   begin
     for i:=l to h do
       begin
-        c := TNormalSet(p^)[i div 8];
-        c := (1 shl (i mod 8)) or c;
-        TNormalSet(p^)[i div 8] := c;
+        c := TNormalSet(p^)[i div 32];
+        c := (1 shl (i mod 32)) or c;
+        TNormalSet(p^)[i div 32] := c;
       end;
   end;
 {$endif}
@@ -104,10 +105,10 @@
    tests if the element b is in the set p the carryflag is set if it present
  }
   var
-    c: byte;
+    c: longint;
   begin
-    c := TNormalSet(p^)[b div 8];
-    if ((1 shl (b mod 8)) and c) <> 0 then
+    c := TNormalSet(p^)[b div 32];
+    if ((1 shl (b mod 32)) and c) <> 0 then
      do_in_byte := TRUE
     else
      do_in_byte := FALSE;
@@ -123,7 +124,7 @@
   var
     i: integer;
    begin
-     for i:=0 to 31 do
+     for i:=0 to 7 do
        TnormalSet(dest^)[i] := TNormalSet(set1^)[i] or TNormalSet(set2^)[i];
    end;
 {$endif}
@@ -137,7 +138,7 @@
    var
     i: integer;
    begin
-     for i:=0 to 31 do
+     for i:=0 to 7 do
        TnormalSet(dest^)[i] := TNormalSet(set1^)[i] and TNormalSet(set2^)[i];
    end;
 {$endif}
@@ -151,7 +152,7 @@
    var
     i: integer;
    begin
-     for i:=0 to 31 do
+     for i:=0 to 7 do
        TnormalSet(dest^)[i] := TNormalSet(set1^)[i] and not TNormalSet(set2^)[i];
    end;
 {$endif}
@@ -165,7 +166,7 @@
    var
     i: integer;
    begin
-     for i:=0 to 31 do
+     for i:=0 to 7 do
        TnormalSet(dest^)[i] := TNormalSet(set1^)[i] xor TNormalSet(set2^)[i];
    end;
 {$endif}
@@ -182,7 +183,7 @@
     i: integer;
    begin
      do_comp_sets := false;
-     for i:=0 to 31 do
+     for i:=0 to 7 do
        if TNormalSet(set1^)[i] <> TNormalSet(set2^)[i] then
          exit;
      do_comp_sets := true;
@@ -203,7 +204,7 @@
   i : integer;
  begin
    do_contains_sets := false;
-   for i:=0 to 31 do
+   for i:=0 to 7 do
      if (TNormalSet(set1^)[i] and TNormalSet(set2^)[i]) <> TNormalSet(set1^)[i] then
        exit;
    do_contains_sets := true;
@@ -212,7 +213,10 @@
 
 {
   $Log$
-  Revision 1.3  2001-05-18 22:59:59  peter
+  Revision 1.4  2001-06-27 21:37:38  peter
+    * v10 merges
+
+  Revision 1.3  2001/05/18 22:59:59  peter
     * merged fixes branch fixes
 
   Revision 1.2  2001/05/09 19:57:07  peter

+ 7 - 2
rtl/inc/text.inc

@@ -211,7 +211,9 @@ Begin
   If TextRec(t).mode=fmClosed Then
    Begin
      Do_Rename(PChar(@TextRec(t).Name),p);
-     Move(p^,TextRec(t).Name,StrLen(p)+1);
+     { check error code of do_rename }
+     If InOutRes = 0 then
+         Move(p^,TextRec(t).Name,StrLen(p)+1);
    End;
 End;
 
@@ -1047,7 +1049,10 @@ end;
 
 {
   $Log$
-  Revision 1.7  2001-06-04 11:43:51  peter
+  Revision 1.8  2001-06-27 21:37:38  peter
+    * v10 merges
+
+  Revision 1.7  2001/06/04 11:43:51  peter
     * Formal const to var fixes
     * Hexstr(int64) added
 

+ 0 - 4
rtl/linux/Makefile

@@ -135,12 +135,8 @@ PRT0=prt0_10
 override FPCOPT+=-dUNIX
 endif
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 ifndef USELIBGGI

+ 0 - 4
rtl/linux/Makefile.fpc

@@ -67,12 +67,8 @@ endif
 # that generates release PPU files
 # which will not be recompiled
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 
 # Paths
 OBJPASDIR=$(RTL)/objpas

+ 12 - 2
rtl/linux/signal.inc

@@ -116,6 +116,13 @@ type
   end;
 {$ENDIF}
 
+{$Ifdef m68k}
+  PSigContextRec = ^SigContextRec;
+  SigContextRec = record
+    { dummy for now PM }
+  end;
+{$ENDIF}
+
 (*
   PSigInfoRec = ^SigInfoRec;
   SigInfoRec = record
@@ -185,7 +192,10 @@ type
 
 {
   $Log$
-  Revision 1.3  2001-04-04 22:50:59  peter
+  Revision 1.4  2001-06-27 21:37:38  peter
+    * v10 merges
+
+  Revision 1.3  2001/04/04 22:50:59  peter
     * use div instead of / in constant
 
   Revision 1.2  2000/09/11 14:05:31  marco
@@ -204,4 +214,4 @@ type
     * signal handling using sigaction when compiled with -dnewsignal
       (allows multiple signals to be received in one run)
 
-}
+}

+ 468 - 206
rtl/objpas/typinfo.pp

@@ -14,7 +14,7 @@
 
  **********************************************************************}
 
-{ This unit provides the same functionality as the TypInfo Unit }
+{ This unit provides the same Functionality as the TypInfo Unit }
 { of Delphi                                                     }
 
 unit typinfo;
@@ -170,7 +170,7 @@ unit typinfo;
         Name : ShortString;
       end;
 
-      TProcInfoProc = procedure(PropInfo : PPropInfo) of object;
+      TProcInfoProc = Procedure(PropInfo : PPropInfo) of object;
 
       PPropList = ^TPropList;
       TPropList = array[0..65535] of PPropInfo;
@@ -182,66 +182,166 @@ unit typinfo;
 
     { general property handling }
     // just skips the id and the name
-    function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
+    Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
 
     // searches in the property PropName
-    function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
-    procedure GetPropInfos(TypeInfo : PTypeInfo;PropList : PPropList);
-    function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds;
+    Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
+    Procedure GetPropInfos(TypeInfo : PTypeInfo;PropList : PPropList);
+    Function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds;
       PropList : PPropList) : Integer;
 
     // returns true, if PropInfo is a stored property
-    function IsStoredProp(Instance : TObject;PropInfo : PPropInfo) : Boolean;
+    Function IsStoredProp(Instance : TObject;PropInfo : PPropInfo) : Boolean;
 
     { subroutines to read/write properties }
-    function GetOrdProp(Instance : TObject;PropInfo : PPropInfo) : Longint;
-    procedure SetOrdProp(Instance : TObject;PropInfo : PPropInfo;
+    Function GetOrdProp(Instance : TObject;PropInfo : PPropInfo) : Longint;
+    Procedure SetOrdProp(Instance : TObject;PropInfo : PPropInfo;
       Value : Longint);
 
-    function GetStrProp(Instance : TObject;PropInfo : PPropInfo) : Ansistring;
-    procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo;
+    Function GetStrProp(Instance : TObject;PropInfo : PPropInfo) : Ansistring;
+    Procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo;
       const Value : Ansistring);
 
-    function GetFloatProp(Instance : TObject;PropInfo : PPropInfo) : Extended;
-    procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
+    Function GetFloatProp(Instance : TObject;PropInfo : PPropInfo) : Extended;
+    Procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
       Value : Extended);
 
-    function GetVariantProp(Instance : TObject;PropInfo : PPropInfo): Variant;
-    procedure SetVariantProp(Instance : TObject;PropInfo : PPropInfo;
+    Function GetVariantProp(Instance : TObject;PropInfo : PPropInfo): Variant;
+    Procedure SetVariantProp(Instance : TObject;PropInfo : PPropInfo;
       const Value: Variant);
 
-    function GetMethodProp(Instance : TObject;PropInfo : PPropInfo) : TMethod;
-    procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo;
+    Function GetMethodProp(Instance : TObject;PropInfo : PPropInfo) : TMethod;
+    Procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo;
       const Value : TMethod);
 
-    function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
-    procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
+    Function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
+    Procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
       const Value: Int64);
 
     { misc. stuff }
-    function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
-    function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
-
-
-  const
+    Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
+    Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
+
+{ Easy access methods, appeared in Delphi 5 }
+Function IsPublishedProp(Instance: TObject; const PropName: string): Boolean; overload;
+Function IsPublishedProp(AClass: TClass; const PropName: string): Boolean; overload;
+Function GetPropInfo(Instance: TObject; const PropName: string): PPropInfo; overload;
+Function GetPropInfo(Instance: TObject; const PropName: string; AKinds: TTypeKinds): PPropInfo; overload;
+Function GetPropInfo(AClass: TClass; const PropName: string): PPropInfo; overload;
+Function GetPropInfo(AClass: TClass; const PropName: string; AKinds: TTypeKinds): PPropInfo; overload;
+Function PropIsType(Instance: TObject; const PropName: string; TypeKind: TTypeKind): Boolean; overload;
+Function PropIsType(AClass: TClass; const PropName: string; TypeKind: TTypeKind): Boolean; overload;
+Function PropType(Instance: TObject; const PropName: string): TTypeKind; overload;
+Function PropType(AClass: TClass; const PropName: string): TTypeKind; overload;
+Function IsStoredProp(Instance: TObject; const PropName: string): Boolean; overload;
+
+Function GetOrdProp(Instance: TObject; const PropName: string): Longint; overload;
+Procedure SetOrdProp(Instance: TObject; const PropName: string; Value: Longint); overload;
+
+Function GetEnumProp(Instance: TObject; const PropName: string): string; overload;
+Procedure SetEnumProp(Instance: TObject; const PropName: string;const Value: string); overload;
+
+// Default false
+Function GetSetProp(Instance: TObject; const PropName: string): string; overload;
+Function GetSetProp(Instance: TObject; const PropName: string; Brackets: Boolean): string; overload;
+Procedure SetSetProp(Instance: TObject; const PropName: string; const Value: string); overload;
+
+// Default nil
+Function GetObjectProp(Instance: TObject; const PropName: string): TObject; overload;
+Function GetObjectProp(Instance: TObject; const PropName: string; MinClass: TClass): TObject; overload;
+Procedure SetObjectProp(Instance: TObject; const PropName: string; Value: TObject); overload;
+Function GetObjectPropClass(Instance: TObject; const PropName: string): TClass; overload;
+
+Function GetStrProp(Instance: TObject; const PropName: string): string; overload;
+Procedure SetStrProp(Instance: TObject; const PropName: string; const Value: string); overload;
+
+Function GetFloatProp(Instance: TObject; const PropName: string): Extended; overload;
+Procedure SetFloatProp(Instance: TObject; const PropName: string; Value: Extended); overload;
+
+Function GetVariantProp(Instance: TObject; const PropName: string): Variant; overload;
+Procedure SetVariantProp(Instance: TObject; const PropName: string; const Value: Variant); overload;
+
+Function GetMethodProp(Instance: TObject; const PropName: string): TMethod; overload;
+Procedure SetMethodProp(Instance: TObject; const PropName: string; const Value: TMethod); overload;
+
+Function GetInt64Prop(Instance: TObject; const PropName: string): Int64; overload;
+Procedure SetInt64Prop(Instance: TObject; const PropName: string;  const Value: Int64); overload;
+
+// Default True
+Function GetPropValue(Instance: TObject; const PropName: string): Variant;
+Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant;
+Procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant);
+
+const
     BooleanIdents: array[Boolean] of String = ('False', 'True');
     DotSep: String = '.';
 
 
-  implementation
+Implementation
 
   type
-
     PMethod = ^TMethod;
 
+{ ---------------------------------------------------------------------
+  Auxiliary methods
+  ---------------------------------------------------------------------}
+
+Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
+
+  Var PS : PShortString;
+      PT : PTypeData;
+
+begin
+ PT:=GetTypeData(TypeInfo);
+ // ^.BaseType);
+ //      If PT^.MinValue<0 then Value:=Ord(Value<>0); {map to 0/1}
+ PS:=@PT^.NameList;
+ While Value>0 Do
+  begin
+    PS:=PShortString(pointer(PS)+PByte(PS)^+1);
+    Dec(Value);
+  end;
+ Result:=PS^;
+end;
+
+Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
+
+  Var PS : PShortString;
+      PT : PTypeData;
+      Count : longint;
+
+begin
+  If Length(Name)=0 then exit(-1);
+  PT:=GetTypeData(TypeInfo);
+  Count:=0;
+  Result:=-1;
+  PS:=@PT^.NameList;
+  While (Result=-1) and (PByte(PS)^<>0) do
+    begin
+    If CompareText(PS^, Name) = 0 then
+      Result:=Count;
+    PS:=PShortString(pointer(PS)+PByte(PS)^+1);
+    Inc(Count);
+    end;
+end;
+
+Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
+
+begin
+  GetTypeData:=PTypeData(pointer(TypeInfo)+2+PByte(pointer(TypeInfo)+1)^);
+end;
+
+{ ---------------------------------------------------------------------
+  Low-level calling of methods.
+  ---------------------------------------------------------------------}
 
 {$ASMMODE ATT}
 
-    function CallIntegerFunc(s: Pointer; Address: Pointer; Index, IValue: LongInt): Int64; assembler;
+Function CallIntegerFunc(s: Pointer; Address: Pointer; Index, IValue: LongInt): Int64; assembler;
       asm
          movl S,%esi
          movl Address,%edi
-         // ? Indexed function
+     // ? Indexed Function
          movl Index,%eax
          testl %eax,%eax
          je .LINoPush
@@ -253,14 +353,14 @@ unit typinfo;
          // now the result is in EDX:EAX
       end;
 
-    function CallIntegerProc(s : Pointer;Address : Pointer;Value : Integer; INdex,IValue : Longint) : Integer;assembler;
+Function CallIntegerProc(s : Pointer;Address : Pointer;Value : Integer; INdex,IValue : Longint) : Integer;assembler;
       asm
          movl S,%esi
          movl Address,%edi
          // Push value to set
          movl Value,%eax
          pushl %eax
-         // ? Indexed procedure
+     // ? Indexed Procedure
          movl Index,%eax
          testl %eax,%eax
          je .LIPNoPush
@@ -271,11 +371,11 @@ unit typinfo;
          call %edi
       end;
 
-    function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
+Function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
       asm
          movl S,%esi
          movl Address,%edi
-         // ? Indexed function
+     // ? Indexed Function
          movl Index,%eax
          testl %eax,%eax
          je .LINoPush
@@ -287,7 +387,7 @@ unit typinfo;
          //
       end;
 
-    function CallExtendedProc(s : Pointer;Address : Pointer;Value : Extended; INdex,IVAlue : Longint) : Integer;assembler;
+Function CallExtendedProc(s : Pointer;Address : Pointer;Value : Extended; INdex,IVAlue : Longint) : Integer;assembler;
       asm
          movl S,%esi
          movl Address,%edi
@@ -296,7 +396,7 @@ unit typinfo;
          pushl (%eax)
          pushl 4(%eax)
          pushl 8(%eax)
-         // ? Indexed procedure
+     // ? Indexed Procedure
          movl Index,%eax
          testl %eax,%eax
          je .LIPNoPush
@@ -307,11 +407,11 @@ unit typinfo;
          call %edi
       end;
 
-    function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
+Function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
       asm
          movl S,%esi
          movl Address,%edi
-         // ? Indexed function
+     // ? Indexed Function
          movl Index,%eax
          testl %eax,%eax
          je .LBNoPush
@@ -322,16 +422,16 @@ unit typinfo;
          call %edi
       end;
 
-    // Assembler functions can't have short stringreturn values.
-    // So we make a procedure with var parameter.
-    // That's not true (FK)
+// Assembler Functions can't have short stringreturn values.
+// So we make a Procedure with var parameter.
+// That's not true (FK)
 
-    Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
+Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
                             Var Res: Shortstring);assembler;
       asm
          movl S,%esi
          movl Address,%edi
-         // ? Indexed function
+     // ? Indexed Function
          movl Index,%eax
          testl %eax,%eax
          jnz .LSSNoPush
@@ -344,14 +444,14 @@ unit typinfo;
          call %edi
       end;
 
-    Procedure CallSStringProc(s : Pointer;Address : Pointer;Const Value : ShortString; INdex,IVAlue : Longint);assembler;
+Procedure CallSStringProc(s : Pointer;Address : Pointer;Const Value : ShortString; INdex,IVAlue : Longint);assembler;
       asm
          movl S,%esi
          movl Address,%edi
          // Push value to set
          movl Value,%eax
          pushl %eax
-         // ? Indexed procedure
+     // ? Indexed Procedure
          movl Index,%eax
          testl %eax,%eax
          je .LSSPNoPush
@@ -362,35 +462,30 @@ unit typinfo;
          call %edi
       end;
 
-    function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
-
-      begin
-         GetTypeData:=PTypeData(pointer(TypeInfo)+2+PByte(pointer(TypeInfo)+1)^);
-      end;
+{ ---------------------------------------------------------------------
+  Basic Type information functions.
+  ---------------------------------------------------------------------}
 
-    function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
+Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
 
-      var
+var
          hp : PTypeData;
          i : longint;
          p : string;
 
-      begin
+begin
          P:=UpCase(PropName);
          while Assigned(TypeInfo) do
            begin
               // skip the name
               hp:=GetTypeData(Typeinfo);
-
-              // the class info rtti the property rtti follows
-              // immediatly
+    // the class info rtti the property rtti follows immediatly
               Result:=PPropInfo(pointer(@hp^.UnitName)+Length(hp^.UnitName)+1+SizeOF(Word));
               for i:=1 to hp^.PropCount do
                 begin
                    // found a property of that name ?
                    if Upcase(Result^.Name)=P then
                      exit;
-
                    // skip to next property
                    Result:=PPropInfo(pointer(@Result^.Name)+byte(Result^.Name[0])+1);
                 end;
@@ -398,11 +493,11 @@ unit typinfo;
               Typeinfo:=hp^.ParentInfo;
            end;
          Result:=Nil;
-      end;
+end;
 
-    function IsStoredProp(Instance : TObject;PropInfo : PPropInfo) : Boolean;
+Function IsStoredProp(Instance : TObject;PropInfo : PPropInfo) : Boolean;
 
-      begin
+begin
          case (PropInfo^.PropProcs shr 4) and 3 of
             ptfield:
               IsStoredProp:=PBoolean(Pointer(Instance)+Longint(PropInfo^.StoredProc))^;
@@ -413,28 +508,28 @@ unit typinfo;
             ptconst:
               IsStoredProp:=LongBool(PropInfo^.StoredProc);
          end;
-      end;
+end;
 
-    procedure GetPropInfos(TypeInfo : PTypeInfo;PropList : PPropList);
-      {
+Procedure GetPropInfos(TypeInfo : PTypeInfo;PropList : PPropList);
+{
         Store Pointers to property information in the list pointed
         to by proplist. PRopList must contain enough space to hold ALL
         properties.
-      }
-      Type PWord = ^Word;
+}
+Type PWord = ^Word;
 
-      Var TD : PTypeData;
+Var TD : PTypeData;
           TP : PPropInfo;
           Count : Longint;
 
-      begin
-      TD:=GetTypeData(TypeInfo);
-      // Get this objects TOTAL published properties count
-      TP:=(@TD^.UnitName+Length(TD^.UnitName)+1);
-      Count:=PWord(TP)^;
-      // Now point TP to first propinfo record.
-      Inc(Longint(TP),SizeOF(Word));
-      While Count>0 do
+begin
+TD:=GetTypeData(TypeInfo);
+// Get this objects TOTAL published properties count
+TP:=(@TD^.UnitName+Length(TD^.UnitName)+1);
+Count:=PWord(TP)^;
+// Now point TP to first propinfo record.
+Inc(Longint(TP),SizeOF(Word));
+While Count>0 do
         begin
         PropList^[0]:=TP;
         Inc(Longint(PropList),SizeOf(Pointer));
@@ -443,24 +538,24 @@ unit typinfo;
         TP:=PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+1);
         Dec(Count);
         end;
-      // recursive call for parent info.
-      If TD^.Parentinfo<>Nil then
+// recursive call for parent info.
+If TD^.Parentinfo<>Nil then
         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;
      While (I<Count) and (PI^.Name>PL^[I]^.Name) do Inc(I);
      If I<Count then
        Move(PL^[I], PL^[I+1], (Count - I) * SizeOf(Pointer));
      PL^[I]:=PI;
-    end;
+end;
 
-    function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds;
+Function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds;
       PropList : PPropList) : Integer;
 
       {
@@ -468,11 +563,11 @@ unit typinfo;
         to by proplist. PRopList must contain enough space to hold ALL
         properties.
       }
-      Var TempList : PPropList;
+Var TempList : PPropList;
           PropInfo : PPropinfo;
           I,Count : longint;
 
-      begin
+begin
         Result:=0;
         Count:=GetTypeData(TypeInfo)^.Propcount;
         If Count>0 then
@@ -493,25 +588,33 @@ unit typinfo;
             FreeMem(TempList,Count*SizeOf(Pointer));
           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);
     If Index<>0 then
       IValue:=P^.Index
     else
       IValue:=0;
-    end;
+end;
+
+{ ---------------------------------------------------------------------
+  Property access functions
+  ---------------------------------------------------------------------}
 
-    function GetOrdProp(Instance : TObject;PropInfo : PPropInfo) : Longint;
+{ ---------------------------------------------------------------------
+  Ordinal properties
+  ---------------------------------------------------------------------}
 
-      var
+Function GetOrdProp(Instance : TObject;PropInfo : PPropInfo) : Longint;
+
+var
          value,Index,Ivalue : longint;
          TypeInfo: PTypeInfo;
 
-      begin
+begin
          SetIndexValues(PropInfo,Index,Ivalue);
          case (PropInfo^.PropProcs) and 3 of
             ptfield:
@@ -537,31 +640,34 @@ unit typinfo;
              end;
          end;
          GetOrdProp:=Value;
-      end;
+end;
 
-    procedure SetOrdProp(Instance : TObject;PropInfo : PPropInfo;
+Procedure SetOrdProp(Instance : TObject;PropInfo : PPropInfo;
       Value : Longint);
 
-      var
+var
         Index,IValue : Longint;
         DataSize: Integer;
 
-      begin
+begin
          if PropInfo^.PropType^.Kind <> tkClass then
            { cut off unnecessary stuff }
            case GetTypeData(PropInfo^.PropType)^.OrdType of
-              otSWord,otUWord: begin
+      otSWord,otUWord:
+        begin
                   Value:=Value and $ffff;
                   DataSize := 2;
                 end;
-              otSByte,otUByte: begin
+      otSByte,otUByte:
+        begin
                   Value:=Value and $ff;
                   DataSize := 1;
               end;
-             else DataSize := 4;
+    else
+        DataSize := 4;
            end
-	 else
-	   DataSize := 4;
+         else
+           DataSize := 4;
          SetIndexValues(PropInfo,Index,Ivalue);
          case (PropInfo^.PropProcs shr 2) and 3 of
             ptfield:
@@ -575,74 +681,139 @@ unit typinfo;
             ptvirtual:
               CallIntegerProc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,Value,Index,IValue);
          end;
-      end;
+end;
+
+
+Function GetOrdProp(Instance: TObject; const PropName: string): Longint;
+
+begin
+end;
+
+Procedure SetOrdProp(Instance: TObject; const PropName: string;  Value: Longint);
+begin
+end;
+
+Function GetEnumProp(Instance: TObject; const PropName: string): string;
+
+begin
+end;
+
+Procedure SetEnumProp(Instance: TObject; const PropName: string;  const Value: string);
+begin
+end;
+
+{ ---------------------------------------------------------------------
+  Set properties
+  ---------------------------------------------------------------------}
+
+
+Function GetSetProp(Instance: TObject; const PropName: string): string;
+
+begin
+  Result:=GetSetProp(Instance,PropName,False);
+end;
 
-    function GetStrProp(Instance: TObject; PropInfo: PPropInfo): AnsiString;
-    var
+Function GetSetProp(Instance: TObject; const PropName: string; Brackets: Boolean): string;
+begin
+end;
+
+Procedure SetSetProp(Instance: TObject; const PropName: string; const Value: string);
+begin
+end;
+
+{ ---------------------------------------------------------------------
+  Object properties
+  ---------------------------------------------------------------------}
+
+Function GetObjectProp(Instance: TObject; const PropName: string): TObject;
+begin
+  Result:=GetObjectProp(Instance,PropName,Nil);
+end;
+
+Function GetObjectProp(Instance: TObject; const PropName: string; MinClass: TClass): TObject;
+begin
+end;
+
+Procedure SetObjectProp(Instance: TObject; const PropName: string;  Value: TObject);
+begin
+end;
+
+Function GetObjectPropClass(Instance: TObject; const PropName: string): TClass;
+begin
+end;
+
+
+{ ---------------------------------------------------------------------
+  String properties
+  ---------------------------------------------------------------------}
+
+Function GetStrProp(Instance: TObject; PropInfo: PPropInfo): AnsiString;
+var
       Index, IValue: LongInt;
       ShortResult: ShortString;
-    begin
+begin
       SetIndexValues(PropInfo, Index, IValue);
       case Propinfo^.PropType^.Kind of
         tkSString:
-	  case (PropInfo^.PropProcs) and 3 of
-	    ptField:
+          case (PropInfo^.PropProcs) and 3 of
+            ptField:
               Result := PShortString(Pointer(Instance) + LongWord(PropInfo^.GetProc))^;
-	    ptStatic:
-	      begin
-		CallSStringFunc(Instance, PropInfo^.GetProc, Index, IValue, ShortResult);
-		Result := ShortResult;
-	      end;
-	    ptVirtual:
-	      begin
-		CallSStringFunc(Instance, PPointer(Pointer(Instance.ClassType) +
-		  LongWord(PropInfo^.GetProc))^, Index, IValue, ShortResult);
-	      Result := ShortResult;
-	    end;
+            ptStatic:
+              begin
+                CallSStringFunc(Instance, PropInfo^.GetProc, Index, IValue, ShortResult);
+                Result := ShortResult;
+              end;
+            ptVirtual:
+              begin
+                CallSStringFunc(Instance, PPointer(Pointer(Instance.ClassType) +
+                  LongWord(PropInfo^.GetProc))^, Index, IValue, ShortResult);
+              Result := ShortResult;
+            end;
+          end;
+        tkAString:
+          case (PropInfo^.PropProcs) and 3 of
+            ptField:
+              Result := PAnsiString(Pointer(Instance) + LongWord(PropInfo^.GetProc))^;
+            ptStatic:
+              Pointer(Result) := Pointer(LongWord(CallIntegerFunc(Instance, PropInfo^.GetProc, Index, IValue)));
+            ptVirtual:
+              Pointer(Result) := Pointer(LongWord(CallIntegerFunc(Instance,
+                PPointer(Pointer(Instance.ClassType) + LongWord(PropInfo^.GetProc))^, Index, IValue)));
           end;
-	tkAString:
-	  case (PropInfo^.PropProcs) and 3 of
-	    ptField:
-	      Result := PAnsiString(Pointer(Instance) + LongWord(PropInfo^.GetProc))^;
-	    ptStatic:
-	      Pointer(Result) := Pointer(LongWord(CallIntegerFunc(Instance, PropInfo^.GetProc, Index, IValue)));
-	    ptVirtual:
-	      Pointer(Result) := Pointer(LongWord(CallIntegerFunc(Instance,
-	        PPointer(Pointer(Instance.ClassType) + LongWord(PropInfo^.GetProc))^, Index, IValue)));
-	  end;
         else
-	  // Property is neither of type AnsiString nor of type ShortString
+          // Property is neither of type AnsiString nor of type ShortString
           SetLength(Result, 0);
       end;
-    end;
+end;
 
-    procedure SetAStrProp(Instance : TObject;PropInfo : PPropInfo;
+Procedure SetAStrProp(Instance : TObject;PropInfo : PPropInfo;
       const Value : AnsiString);
 
-      {
-      Dirty trick based on fact that AnsiString is just a pointer,
-      hence can be treated like an integer type.
-      }
-      var
+{
+Dirty trick based on fact that AnsiString is just a pointer,
+hence can be treated like an integer type.
+}
+var
          Index,Ivalue : Longint;
-      begin
+
+begin
          SetIndexValues(PropInfo,Index,IValue);
          case (PropInfo^.PropProcs shr 2) and 3 of
             ptfield:
-	      PAnsiString(Pointer(Instance) + Longint(PropInfo^.SetProc))^ := Value;
+              PAnsiString(Pointer(Instance) + Longint(PropInfo^.SetProc))^ := Value;
             ptstatic:
               CallIntegerProc(Instance,PropInfo^.SetProc,Longint(Pointer(Value)),Index,IValue);
             ptvirtual:
               CallIntegerProc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,Longint(Pointer(Value)),Index,IValue);
          end;
-      end;
+end;
 
-    procedure SetSStrProp(Instance : TObject;PropInfo : PPropInfo;
+Procedure SetSStrProp(Instance : TObject;PropInfo : PPropInfo;
       const Value : ShortString);
 
-   Var Index,IValue: longint;
+Var Index,IValue: longint;
 
-    begin
+begin
       SetIndexValues(PRopInfo,Index,IValue);
          case (PropInfo^.PropProcs shr 2) and 3 of
             ptfield:
@@ -652,26 +823,38 @@ unit typinfo;
             ptvirtual:
               CallSStringProc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,Value,Index,IValue);
          end;
-    end;
+end;
 
-    procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo;
+Procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo;
       const Value : AnsiString);
 
-      begin
+begin
       Case Propinfo^.PropType^.Kind of
         tkSString : SetSStrProp(Instance,PropInfo,Value);
         tkAString : SetAStrProp(Instance,Propinfo,Value);
       end;
-      end;
+end;
+
+
+Function GetStrProp(Instance: TObject; const PropName: string): string;
+begin
+end;
+
+Procedure SetStrProp(Instance: TObject; const PropName: string;  const Value: string);
+begin
+end;
+
+{ ---------------------------------------------------------------------
+  Float properties
+  ---------------------------------------------------------------------}
 
-    function GetFloatProp(Instance : TObject;PropInfo : PPropInfo) : Extended;
+Function GetFloatProp(Instance : TObject;PropInfo : PPropInfo) : Extended;
 
-      var
+var
          Index,Ivalue : longint;
          Value : Extended;
 
-
-      begin
+begin
          SetIndexValues(PropInfo,Index,Ivalue);
          case (PropInfo^.PropProcs) and 3 of
             ptfield:
@@ -697,14 +880,14 @@ unit typinfo;
               Value:=CallExtendedFunc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,Index,IValue);
          end;
          Result:=Value;
-      end;
+end;
 
-    procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
+Procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
       Value : Extended);
 
        Var IValue,Index : longint;
 
-       begin
+begin
          SetIndexValues(PropInfo,Index,Ivalue);
          case (PropInfo^.PropProcs shr 2) and 3 of
             ptfield:
@@ -729,29 +912,57 @@ unit typinfo;
             ptvirtual:
               CallExtendedProc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,Value,Index,IValue);
          end;
-      end;
+end;
+
+Function GetFloatProp(Instance: TObject; const PropName: string): Extended;
+begin
+end;
 
-    function GetVariantProp(Instance : TObject;PropInfo : PPropInfo): Variant;
+Procedure SetFloatProp(Instance: TObject; const PropName: string;  Value: Extended);
+begin
+end;
 
-      begin
+{ ---------------------------------------------------------------------
+  Variant properties
+  ---------------------------------------------------------------------}
+
+Function GetVariantProp(Instance : TObject;PropInfo : PPropInfo): Variant;
+
+begin
          {!!!!!!!!!!!}
          Result:=nil;
-      end;
+end;
 
-    procedure SetVariantProp(Instance : TObject;PropInfo : PPropInfo;
+Procedure SetVariantProp(Instance : TObject;PropInfo : PPropInfo;
       const Value: Variant);
 
-      begin
+begin
          {!!!!!!!!!!!}
-      end;
+end;
+
+Function GetVariantProp(Instance: TObject; const PropName: string): Variant;
+begin
+   {!!!!!!!!!!!}
+end;
+
+Procedure SetVariantProp(Instance: TObject; const PropName: string;  const Value: Variant);
+begin
+   {!!!!!!!!!!!}
+end;
+
+
+{ ---------------------------------------------------------------------
+  Method properties
+  ---------------------------------------------------------------------}
+
 
-    function GetMethodProp(Instance : TObject;PropInfo : PPropInfo) : TMethod;
+Function GetMethodProp(Instance : TObject;PropInfo : PPropInfo) : TMethod;
 
-      var
+var
          value: PMethod;
          Index,Ivalue : longint;
 
-      begin
+begin
          SetIndexValues(PropInfo,Index,Ivalue);
          case (PropInfo^.PropProcs) and 3 of
             ptfield:
@@ -762,15 +973,15 @@ unit typinfo;
               Value:=PMethod(LongInt(CallIntegerFunc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,Index,IValue)));
          end;
          GetMethodProp:=Value^;
-      end;
+end;
 
-    procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo;
+Procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo;
       const Value : TMethod);
 
-      var
+var
         Index,IValue : Longint;
 
-      begin
+begin
          SetIndexValues(PropInfo,Index,Ivalue);
          case (PropInfo^.PropProcs shr 2) and 3 of
             ptfield:
@@ -782,22 +993,34 @@ unit typinfo;
                 PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,
                 Integer(@Value), Index, IValue);
          end;
-      end;
+end;
+
+Function GetMethodProp(Instance: TObject; const PropName: string): TMethod;
+begin
+end;
+
+Procedure SetMethodProp(Instance: TObject; const PropName: string;  const Value: TMethod);
+begin
+end;
 
-    function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
-    var
+{ ---------------------------------------------------------------------
+  Int64 properties
+  ---------------------------------------------------------------------}
+
+Function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
+var
       Index, IValue: LongInt;
-    begin
+begin
       SetIndexValues(PropInfo,Index,Ivalue);
       case PropInfo^.PropProcs and 3 of
         ptfield:
-	  Result := PInt64(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
+          Result := PInt64(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
         ptstatic:
           Result := CallIntegerFunc(Instance, PropInfo^.GetProc, Index, IValue);
         ptvirtual:
           Result := CallIntegerFunc(Instance,
-	    PPointer(Pointer(Instance.ClassType) + LongInt(PropInfo^.GetProc))^,
-	    Index, IValue);
+            PPointer(Pointer(Instance.ClassType) + LongInt(PropInfo^.GetProc))^,
+            Index, IValue);
       end;
     end;
 
@@ -807,50 +1030,89 @@ unit typinfo;
       // !!!: Implement me!
     end;
 
-    function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
+Function GetInt64Prop(Instance: TObject; const PropName: string): Int64;
+begin
+end;
 
-      Var PS : PShortString;
-          PT : PTypeData;
+Procedure SetInt64Prop(Instance: TObject; const PropName: string; const Value: Int64);
+begin
+end;
 
-      begin
-       PT:=GetTypeData(TypeInfo);
-       // ^.BaseType);
-       //      If PT^.MinValue<0 then Value:=Ord(Value<>0); {map to 0/1}
-       PS:=@PT^.NameList;
-       While Value>0 Do
-        begin
-          PS:=PShortString(pointer(PS)+PByte(PS)^+1);
-          Dec(Value);
-        end;
-       Result:=PS^;
-      end;
 
-    function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
+{ ---------------------------------------------------------------------
+  All properties through variant.
+  ---------------------------------------------------------------------}
 
-      Var PS : PShortString;
-          PT : PTypeData;
-          Count : longint;
+Function GetPropValue(Instance: TObject; const PropName: string): Variant;
+begin
+  Result:=GetPropValue(Instance,PropName,True);
+end;
 
-      begin
-        If Length(Name)=0 then exit(-1);
-        PT:=GetTypeData(TypeInfo);
-        Count:=0;
-        Result:=-1;
-        PS:=@PT^.NameList;
-        While (Result=-1) and (PByte(PS)^<>0) do
-          begin
-          If CompareText(PS^, Name) = 0 then
-            Result:=Count;
-          PS:=PShortString(pointer(PS)+PByte(PS)^+1);
-          Inc(Count);
-          end;
-      end;
+Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant;
+begin
+end;
 
-end.
+Procedure SetPropValue(Instance: TObject; const PropName: string;  const Value: Variant);
+begin
+end;
+
+{ ---------------------------------------------------------------------
+  Easy access methods that appeared in Delphi 5
+  ---------------------------------------------------------------------}
 
+Function IsPublishedProp(Instance: TObject; const PropName: string): Boolean;
+begin
+end;
+
+Function IsPublishedProp(AClass: TClass; const PropName: string): Boolean;
+begin
+end;
+
+Function GetPropInfo(Instance: TObject; const PropName: string): PPropInfo;
+begin
+  Result:=GetPropInfo(Instance,PropName,[]);
+end;
+
+Function GetPropInfo(Instance: TObject; const PropName: string; AKinds: TTypeKinds): PPropInfo;
+begin
+end;
+
+Function GetPropInfo(AClass: TClass; const PropName: string): PPropInfo;
+begin
+  Result:=GetPropInfo(AClass,PropName,[]);
+end;
+
+Function GetPropInfo(AClass: TClass; const PropName: string; AKinds: TTypeKinds): PPropInfo;
+begin
+end;
+
+Function PropIsType(Instance: TObject; const PropName: string; TypeKind: TTypeKind): Boolean;
+begin
+end;
+
+Function PropIsType(AClass: TClass; const PropName: string; TypeKind: TTypeKind): Boolean;
+begin
+end;
+
+Function PropType(Instance: TObject; const PropName: string): TTypeKind;
+begin
+end;
+
+Function PropType(AClass: TClass; const PropName: string): TTypeKind;
+begin
+end;
+
+Function IsStoredProp(Instance: TObject; const PropName: string): Boolean;
+begin
+end;
+
+end.
 {
   $Log$
-  Revision 1.7  2001-02-15 22:40:22  sg
+  Revision 1.8  2001-06-27 21:37:38  peter
+    * v10 merges
+
+  Revision 1.7  2001/02/15 22:40:22  sg
   * Fixed SetOrdProp for class instance properties (merged from fixbranch)
 
   Revision 1.6  2000/12/13 23:28:17  sg

+ 0 - 4
rtl/os2/Makefile

@@ -130,12 +130,8 @@ else
 SYSTEMUNIT=sysos2
 endif
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi dive dos crt objects printer sysutils math typinfo varutils ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard

+ 0 - 4
rtl/os2/Makefile.fpc

@@ -50,12 +50,8 @@ endif
 # that generates release PPU files
 # which will not be recompiled
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 
 # Paths
 OBJPASDIR=$(RTL)/objpas

+ 18 - 2
rtl/unix/keyboard.pp

@@ -259,6 +259,14 @@ const
   );
  KDGKBENT=$4B46;
  KDSKBENT=$4B47;
+ KDGKBMETA=$4B62;
+ KDSKBMETA=$4B63;
+ K_ESCPREFIX=$4;
+ K_METABIT=$3;
+
+const
+  oldmeta : longint = 0;
+  meta : longint = 0;
 
 procedure PatchKeyboard;
 var
@@ -266,6 +274,9 @@ var
   entry : kbentry;
   i : longint;
 begin
+  Ioctl(stdinputhandle,KDGKBMETA,@oldmeta);
+  meta:=K_ESCPREFIX;
+  Ioctl(stdinputhandle,KDSKBMETA,@meta);
   for i:=1 to kbdchanges do
    begin
      e:=@kbdchange[i];
@@ -278,7 +289,7 @@ begin
      ioctl(stdinputhandle,KDGKBENT,@entry);
      e^.newval:=entry.kb_value;
    end;
-  for i:=1to kbdchanges do
+  for i:=1 to kbdchanges do
    begin
      e:=@kbdchange[i];
      entry.kb_table:=e^.tab;
@@ -295,6 +306,8 @@ var
   entry : kbentry;
   i : longint;
 begin
+  if oldmeta in [K_ESCPREFIX,K_METABIT] then
+    Ioctl(stdinputhandle,KDSKBMETA,@oldmeta);
   for i:=1 to kbdchanges do
    begin
      e:=@kbdchange[i];
@@ -1697,7 +1710,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2001-04-10 23:35:02  peter
+  Revision 1.4  2001-06-27 21:37:38  peter
+    * v10 merges
+
+  Revision 1.3  2001/04/10 23:35:02  peter
     * fixed argument name
     * merged fixes
 

+ 9 - 6
rtl/unix/sysunixh.inc

@@ -15,17 +15,17 @@
 
  **********************************************************************}
 
+{$define newsignal}
+
+{$I systemh.inc}
+{$I heaph.inc}
+
 {$ifdef m68k}
 { used for single computations }
 const
   BIAS4 = $7f-1;
 {$endif}
 
-{$define newsignal}
-
-{$I systemh.inc}
-{$I heaph.inc}
-
 {Platform specific information}
 const
  LineEnding = #10;
@@ -54,7 +54,10 @@ var
 
 {
   $Log$
-  Revision 1.9  2001-06-18 14:26:16  jonas
+  Revision 1.10  2001-06-27 21:37:39  peter
+    * v10 merges
+
+  Revision 1.9  2001/06/18 14:26:16  jonas
     * move platform independent constant declarations after inclusion of
       systemh.inc
 

+ 0 - 4
rtl/win32/Makefile

@@ -132,12 +132,8 @@ SYSTEMUNIT=syswin32
 PRT0=wprt0_10
 endif
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 include $(WININC)/makefile.inc

+ 0 - 4
rtl/win32/Makefile.fpc

@@ -52,12 +52,8 @@ endif
 # that generates release PPU files
 # which will not be recompiled
 ifdef RELEASE
-ifneq ($(findstring 1.0.2,$(FPC_VERSION)),)
-ifneq ($(findstring 1.0.4,$(FPC_VERSION)),)
 override FPCOPT+=-Ur
 endif
-endif
-endif
 
 # Paths
 OBJPASDIR=$(RTL)/objpas

+ 5 - 1
rtl/win32/wininc/base.inc

@@ -123,6 +123,7 @@
      HSZ = HANDLE;
      HWINSTA = HANDLE;
      HWND = HANDLE;
+     HTASK = HANDLE;
 
      LANGID = word;
      LCID   = DWORD;
@@ -941,7 +942,10 @@ type
 
 {
   $Log$
-  Revision 1.5  2000-12-18 17:28:58  jonas
+  Revision 1.6  2001-06-27 21:37:39  peter
+    * v10 merges
+
+  Revision 1.5  2000/12/18 17:28:58  jonas
     * fixed range check errors
 
   Revision 1.4  2000/10/11 16:05:56  peter