From 612d58c80f80a7328f9efc651d575b3ae00b7a47 Mon Sep 17 00:00:00 2001
From: michael <michael@freepascal.org>
Date: Thu, 27 Aug 2009 18:40:17 +0000
Subject: [PATCH] * Patch from Dariusz Mazur to fix compilation with Delphi

git-svn-id: trunk@13602 -
---
 packages/fcl-xml/src/dom.pp      | 24 +++++++++++++++---------
 packages/fcl-xml/src/xmlutils.pp | 26 +++++++++++++++++++++-----
 packages/fcl-xml/src/xmlwrite.pp |  6 ++++--
 3 files changed, 40 insertions(+), 16 deletions(-)

diff --git a/packages/fcl-xml/src/dom.pp b/packages/fcl-xml/src/dom.pp
index 6c1e3d0d27..e8032cb44a 100644
--- a/packages/fcl-xml/src/dom.pp
+++ b/packages/fcl-xml/src/dom.pp
@@ -43,6 +43,10 @@ uses
 // -------------------------------------------------------
 //   DOMException
 // -------------------------------------------------------
+{$ifndef fpc}
+type
+  tFpList = tList;
+{$endif}
 
 const
 
@@ -101,6 +105,8 @@ type
   TDOMAttrDef = class;
   PNodePool = ^TNodePool;
   TNodePool = class;
+  TTabNodePool = array[0..0] of TNodePool;
+  PTabNodePool = ^TTabNodePool;
 
 
 // -------------------------------------------------------
@@ -430,7 +436,7 @@ type
     FEmptyNode: TDOMElement;
     FNodeLists: THashTable;
     FMaxPoolSize: Integer;
-    FPools: PNodePool;
+    FPools: PTabNodePool;
     FDocumentURI: DOMString;
     function GetDocumentElement: TDOMElement;
     function GetDocType: TDOMDocumentType;
@@ -3167,24 +3173,24 @@ var
   sz: Integer;
 begin
   ext := FCurrExtent;
-  ptr := Pointer(FCurrBlock) + FElementSize;
+  ptrInt(ptr) := ptrInt(FCurrBlock) + FElementSize;
   sz := FCurrExtentSize;
   while Assigned(ext) do
   begin
     // call destructors for everyone still there
-    ptr_end := Pointer(ext) + sizeof(TExtent) + (sz - 1) * FElementSize;
-    while ptr <= ptr_end do
+    ptrInt(ptr_end) := ptrInt(ext) + sizeof(TExtent) + (sz - 1) * FElementSize;
+    while ptrInt(ptr) <= ptrInt(ptr_end) do
     begin
       if TDOMNode(ptr).FPool = Self then
         TObject(ptr).Destroy;
-      Inc(ptr, FElementSize);
+      Inc(ptrInt(ptr), FElementSize);
     end;
     // dispose the extent and pass to the next one
     next := ext^.Next;
     FreeMem(ext);
     ext := next;
     sz := sz div 2;
-    ptr := Pointer(ext) + sizeof(TExtent);
+    ptrInt(ptr) := ptrInt(ext) + sizeof(TExtent);
   end;
   inherited Destroy;
 end;
@@ -3194,13 +3200,13 @@ var
   ext: PExtent;
 begin
   Assert((FCurrExtent = nil) or
-    (Pointer(FCurrBlock) = Pointer(FCurrExtent) + sizeof(TExtent)));
+    (ptrInt(FCurrBlock) = ptrInt(FCurrExtent) + sizeof(TExtent)));
   Assert(AElemCount > 0);
 
   GetMem(ext, sizeof(TExtent) + AElemCount * FElementSize);
   ext^.Next := FCurrExtent;
   // point to the beginning of the last block of extent
-  FCurrBlock := TDOMNode(Pointer(ext) + sizeof(TExtent) + (AElemCount - 1) * FElementSize);
+  FCurrBlock := TDOMNode(ptrInt(ext) + sizeof(TExtent) + (AElemCount - 1) * FElementSize);
   FCurrExtent := ext;
   FCurrExtentSize := AElemCount;
 end;
@@ -3214,7 +3220,7 @@ begin
   end
   else
   begin
-    if Pointer(FCurrBlock) = Pointer(FCurrExtent) + sizeof(TExtent) then
+    if ptrInt(FCurrBlock) = ptrInt(FCurrExtent) + sizeof(TExtent) then
       AddExtent(FCurrExtentSize * 2);
     Result := FCurrBlock;
     Dec(PChar(FCurrBlock), FElementSize);
diff --git a/packages/fcl-xml/src/xmlutils.pp b/packages/fcl-xml/src/xmlutils.pp
index 89aa8fc0e2..e1bc3c4228 100644
--- a/packages/fcl-xml/src/xmlutils.pp
+++ b/packages/fcl-xml/src/xmlutils.pp
@@ -14,14 +14,20 @@
  **********************************************************************}
 unit xmlutils;
 
-{$mode objfpc}
-{$H+}
+{$ifdef fpc}
+{$MODE objfpc}{$H+}
+{$endif}
 
 interface
 
 uses
   SysUtils;
 
+ {$IFNDEF FPC}
+
+type   ptrint=integer;
+{$ENDIF} 
+
 function IsXmlName(const Value: WideString; Xml11: Boolean = False): Boolean; overload;
 function IsXmlName(Value: PWideChar; Len: Integer; Xml11: Boolean = False): Boolean; overload;
 function IsXmlNames(const Value: WideString; Xml11: Boolean = False): Boolean;
@@ -38,6 +44,7 @@ function WStrLIComp(S1, S2: PWideChar; Len: Integer): Integer;
 { a simple hash table with WideString keys }
 
 type
+  PTabPHashItem = ^TTabPHashItem;
   PPHashItem = ^PHashItem;
   PHashItem = ^THashItem;
   THashItem = record
@@ -46,6 +53,7 @@ type
     Next: PHashItem;
     Data: TObject;
   end;
+  TTabPHashItem = array[0..0] of pHashItem;
 
   THashForEach = function(Entry: PHashItem; arg: Pointer): Boolean;
 
@@ -53,7 +61,7 @@ type
   private
     FCount: LongWord;
     FBucketCount: LongWord;
-    FBucket: PPHashItem;
+    FBucket: PTabPHashItem;
     FOwnsObjects: Boolean;
     function Lookup(Key: PWideChar; KeyLength: Integer; var Found: Boolean; CanCreate: Boolean): PHashItem;
     procedure Resize(NewCapacity: LongWord);
@@ -82,12 +90,15 @@ type
     lname: PWideChar;
     lnameLen: Integer;
   end;
+  PTabExpHashEntry = ^TTabExpHashEntry;
+  tTabExpHashEntry = array[0..0] of   TExpHashEntry;
+
 
   TDblHashArray = class(TObject)
   private
     FSizeLog: Integer;
     FRevision: LongWord;
-    FData: PExpHashEntry;
+    FData: PTabExpHashEntry;
   public  
     procedure Init(NumSlots: Integer);
     function Locate(uri: PWideString; localName: PWideChar; localLength: Integer): Boolean;
@@ -347,7 +358,11 @@ end;
 
 function KeyCompare(const Key1: WideString; Key2: Pointer; Key2Len: Integer): Boolean;
 begin
+  {$IFDEF FPC}
   Result := (Length(Key1)=Key2Len) and (CompareWord(Pointer(Key1)^, Key2^, Key2Len) = 0);
+  {$ELSE}
+  Result := comparemem(Pointer(Key1),key2,key2len*2);
+  {$ENDIF}
 end;
 
 { THashTable }
@@ -461,7 +476,8 @@ end;
 
 procedure THashTable.Resize(NewCapacity: LongWord);
 var
-  p, chain: PPHashItem;
+  p    : PTabPHashItem;
+  chain: PPHashItem;
   i: Integer;
   e, n: PHashItem;
 begin
diff --git a/packages/fcl-xml/src/xmlwrite.pp b/packages/fcl-xml/src/xmlwrite.pp
index 3586d77e1c..ee9b017c86 100644
--- a/packages/fcl-xml/src/xmlwrite.pp
+++ b/packages/fcl-xml/src/xmlwrite.pp
@@ -17,8 +17,10 @@
 
 unit XMLWrite;
 
-{$MODE objfpc}
-{$H+}
+
+{$ifdef fpc}
+{$MODE objfpc}{$H+}
+{$endif}
 
 interface