MG: accelerated xmlread and xmlwrite

git-svn-id: trunk@1797 -

components/codetools/laz_dom.pas

@@ -72,8 +72,10 @@ type
 
 {$IFDEF ver1_0}
   DOMString = String;
+  DOMPChar = PChar;
 {$ELSE}
   DOMString = WideString;
+  DOMPChar = PWideChar;
 {$ENDIF}
 
 
@@ -749,16 +751,33 @@ end;
 
 //------------------------------------------------------------------------------
 
+function CompareDOMStrings(const s1, s2: DOMPChar; l1, l2: integer): integer;
+var i: integer;
+begin
+  Result:=l1-l2;
+  i:=1;
+  while (i<=l1) and (Result=0) do begin
+    Result:=ord(s1[i])-ord(s2[i]);
+    inc(i);
+  end;
+end;
+
 function CompareDOMNodeWithDOMNode(Data1, Data2: Pointer): integer;
 begin
-  Result:=AnsiCompareStr(TDOMNode(Data1).NodeName,
+  Result:=CompareDOMStrings(DOMPChar(TDOMNode(Data1).NodeName),
-                         TDOMNode(Data2).NodeName);
+                            DOMPChar(TDOMNode(Data2).NodeName),
+                            length(TDOMNode(Data1).NodeName),
+                            length(TDOMNode(Data2).NodeName)
+                            );
 end;
 
 function CompareDOMStringWithDOMNode(Data1, Data2: Pointer): integer;
 begin
-  Result:=AnsiCompareStr(DOMString(Data1),
+  Result:=CompareDOMStrings(DOMPChar(Data1),
-                         TDOMNode(Data2).NodeName);
+                            DOMPChar(TDOMNode(Data2).NodeName),
+                            length(DOMString(Data1)),
+                            length(TDOMNode(Data2).NodeName)
+                            );
 end;
 
 
@@ -1596,6 +1615,9 @@ end.
 
 {
   $Log$
+  Revision 1.2  2002/07/30 14:36:27  lazarus
+  MG: accelerated xmlread and xmlwrite
+
   Revision 1.1  2002/07/30 06:24:05  lazarus
   MG: added a faster version of TXMLConfig
 

components/codetools/laz_xmlcfg.pas

@@ -89,18 +89,10 @@ begin
 end;
 
 procedure TXMLConfig.Flush;
-var
-  f: Text;
 begin
   if Modified then
   begin
-    AssignFile(f, Filename);
+    WriteXMLFile(doc, Filename);
-    Rewrite(f);
-    try
-      WriteXMLFile(doc, f);
-    finally
-      CloseFile(f);
-    end;
     FModified := False;
   end;
 end;
@@ -111,14 +103,14 @@ var
   i: Integer;
   NodePath: String;
 begin
-  Node := doc.DocumentElement; // MAT: check this
+  Node := doc.DocumentElement;
   NodePath := APath;
   while True do
   begin
     i := Pos('/', NodePath);
     if i = 0 then
       break;
-    Child := Node.FindNode(Copy(NodePath, 1, i - 1)); // MAT: check this
+    Child := Node.FindNode(Copy(NodePath, 1, i - 1));
     NodePath := Copy(NodePath, i + 1, Length(NodePath));
     if not Assigned(Child) then
     begin
@@ -127,7 +119,7 @@ begin
     end;
     Node := Child;
   end;
-  Attr := Node.Attributes.GetNamedItem(NodePath); // MAT: check this
+  Attr := Node.Attributes.GetNamedItem(NodePath);
   if Assigned(Attr) then
     Result := Attr.NodeValue
   else
@@ -251,6 +243,9 @@ end;
 end.
 {
   $Log$
+  Revision 1.2  2002/07/30 14:36:28  lazarus
+  MG: accelerated xmlread and xmlwrite
+
   Revision 1.1  2002/07/30 06:24:06  lazarus
   MG: added a faster version of TXMLConfig
 

components/codetools/laz_xmlread.pas

@@ -88,7 +88,9 @@ type
     procedure ExpectWhitespace;
     procedure ExpectString(s: String);
     function  CheckFor(s: PChar): Boolean;
+    procedure SkipString(ValidChars: TSetOfChar);
     function  GetString(ValidChars: TSetOfChar): String;
+    function  GetString(BufPos: PChar; Len: integer): String;
 
     function  GetName(var s: String): Boolean;
     function  ExpectName: String;                                       // [5]
@@ -200,15 +202,40 @@ begin
     Result := False;
 end;
 
-function TXMLReader.GetString(ValidChars: TSetOfChar): String;
+procedure TXMLReader.SkipString(ValidChars: TSetOfChar);
 begin
-  SetLength(Result, 0);
   while buf[0] in ValidChars do begin
-    Result := Result + buf[0];
     Inc(buf);
   end;
 end;
 
+function TXMLReader.GetString(ValidChars: TSetOfChar): String;
+var
+  OldBuf: PChar;
+  i, len: integer;
+begin
+  OldBuf:=Buf;
+  while buf[0] in ValidChars do begin
+    Inc(buf);
+  end;
+  len:=buf-OldBuf;
+  SetLength(Result, Len);
+  for i:=1 to len do begin
+    Result[i]:=OldBuf[0];
+    inc(OldBuf);
+  end;
+end;
+
+function TXMLReader.GetString(BufPos: PChar; Len: integer): string;
+var i: integer;
+begin
+  SetLength(Result,Len);
+  for i:=1 to Len do begin
+    Result[i]:=BufPos[0];
+    inc(BufPos);
+  end;
+end;
+
 procedure TXMLReader.ProcessXML(ABuf: PChar; AFilename: String);    // [1]
 //var
 //  LastNodeBeforeDoc: TDOMNode;
@@ -237,6 +264,7 @@ end;
 
 
 function TXMLReader.GetName(var s: String): Boolean;    // [5]
+var OldBuf: PChar;
 begin
   SetLength(s, 0);
   if not (buf[0] in (Letter + ['_', ':'])) then begin
@@ -244,28 +272,36 @@ begin
     exit;
   end;
 
-  s := buf[0];
+  OldBuf := buf;
   Inc(buf);
-  s := s + GetString(Letter + ['0'..'9', '.', '-', '_', ':']);
+  SkipString(Letter + ['0'..'9', '.', '-', '_', ':']);
+  s := GetString(OldBuf,buf-OldBuf);
   Result := True;
 end;
 
 function TXMLReader.ExpectName: String;    // [5]
+var OldBuf: PChar;
 begin
   if not (buf[0] in (Letter + ['_', ':'])) then
     RaiseExc('Expected letter, "_" or ":" for name, found "' + buf[0] + '"');
 
-  Result := buf[0];
+  OldBuf := buf;
   Inc(buf);
-  Result := Result + GetString(Letter + ['0'..'9', '.', '-', '_', ':']);
+  SkipString(Letter + ['0'..'9', '.', '-', '_', ':']);
+  Result:=GetString(OldBuf,buf-OldBuf);
 end;
 
 procedure TXMLReader.ExpectAttValue(attr: TDOMAttr);    // [10]
 var
   s: String;
+  OldBuf: PChar;
 
   procedure FlushStringBuffer;
   begin
+    if OldBuf<>buf then begin
+      s := s + GetString(OldBuf,buf-OldBuf);
+      OldBuf := buf;
+    end;
     if Length(s) > 0 then
     begin
       attr.AppendChild(doc.CreateTextNode(s));
@@ -282,6 +318,7 @@ begin
   StrDel[1] := #0;
   Inc(buf);
   SetLength(s, 0);
+  OldBuf := buf;
   while not CheckFor(StrDel) do
     if buf[0] = '&' then
     begin
@@ -289,10 +326,11 @@ begin
       ParseReference(attr);
     end else
     begin
-      s := s + buf[0];
       Inc(buf);
     end;
+  dec(buf);
   FlushStringBuffer;
+  inc(buf);
   ResolveEntities(Attr);
 end;
 
@@ -300,10 +338,10 @@ function TXMLReader.ExpectPubidLiteral: String;
 begin
   SetLength(Result, 0);
   if CheckFor('''') then begin
-    GetString(PubidChars - ['''']);
+    SkipString(PubidChars - ['''']);
     ExpectString('''');
   end else if CheckFor('"') then begin
-    GetString(PubidChars - ['"']);
+    SkipString(PubidChars - ['"']);
     ExpectString('"');
   end else
     RaiseExc('Expected quotation marks');
@@ -312,14 +350,16 @@ end;
 function TXMLReader.ParseComment(AOwner: TDOMNode): Boolean;    // [15]
 var
   comment: String;
+  OldBuf: PChar;
 begin
   if CheckFor('<!--') then begin
     SetLength(comment, 0);
+    OldBuf := buf;
     while (buf[0] <> #0) and (buf[1] <> #0) and
       ((buf[0] <> '-') or (buf[1] <> '-')) do begin
-      comment := comment + buf[0];
       Inc(buf);
     end;
+    comment:=GetString(OldBuf,buf-OldBuf);
     AOwner.AppendChild(doc.CreateComment(comment));
     ExpectString('-->');
     Result := True;
@@ -435,7 +475,7 @@ begin
       if CheckFor('[') then
       begin
         ParseDoctypeDecls;
-	SkipWhitespace;
+        SkipWhitespace;
       end;
       ExpectString('>');
     end;
@@ -589,12 +629,12 @@ function TXMLReader.ParseMarkupDecl: Boolean;    // [29]
           end;
         end else if CheckFor('(') then begin    // [59]
           SkipWhitespace;
-          GetString(Nmtoken);
+          SkipString(Nmtoken);
           SkipWhitespace;
           while not CheckFor(')') do begin
             ExpectString('|');
             SkipWhitespace;
-            GetString(Nmtoken);
+            SkipString(Nmtoken);
             SkipWhitespace;
           end;
         end else
@@ -728,13 +768,15 @@ var
   var
     s: String;
     i: Integer;
+    OldBuf: PChar;
   begin
     SetLength(s, 0);
+    OldBuf := buf;
     while not (buf[0] in [#0, '<', '&']) do
     begin
-      s := s + buf[0];
       Inc(buf);
     end;
+    s:=GetString(OldBuf,buf-OldBuf);
     if Length(s) > 0 then
     begin
       // Check if s has non-whitespace content
@@ -742,7 +784,7 @@ var
       while (i > 0) and (s[i] in WhitespaceChars) do
         Dec(i);
       if i > 0 then
-	NewElem.AppendChild(doc.CreateTextNode(s));
+        NewElem.AppendChild(doc.CreateTextNode(s));
       Result := True;
     end else
       Result := False;
@@ -751,15 +793,17 @@ var
   function ParseCDSect: Boolean;    // [18]
   var
     cdata: String;
+    OldBuf: PChar;
   begin
     if CheckFor('<![CDATA[') then
     begin
       SetLength(cdata, 0);
+      OldBuf := buf;
       while not CheckFor(']]>') do
       begin
-        cdata := cdata + buf[0];
         Inc(buf);
       end;
+      cdata := GetString(OldBuf,buf-OldBuf);
       NewElem.AppendChild(doc.CreateCDATASection(cdata));
       Result := True;
     end else
@@ -879,21 +923,25 @@ end;
 function TXMLReader.ParseExternalID: Boolean;    // [75]
 
   function GetSystemLiteral: String;
+  var
+    OldBuf: PChar;
   begin
     SetLength(Result, 0);
     if buf[0] = '''' then begin
       Inc(buf);
+      OldBuf := buf;
       while (buf[0] <> '''') and (buf[0] <> #0) do begin
-        Result := Result + buf[0];
         Inc(buf);
       end;
+      Result := GetString(OldBuf,buf-OldBuf);
       ExpectString('''');
     end else if buf[0] = '"' then begin
       Inc(buf);
+      OldBuf := buf;
       while (buf[0] <> '"') and (buf[0] <> #0) do begin
-        Result := Result + buf[0];
         Inc(buf);
       end;
+      Result := GetString(OldBuf,buf-OldBuf);
       ExpectString('"');
     end;
   end;
@@ -922,12 +970,14 @@ end;
 function TXMLReader.ParseEncodingDecl: String;    // [80]
 
   function ParseEncName: String;
+  var OldBuf: PChar;
   begin
     if not (buf[0] in ['A'..'Z', 'a'..'z']) then
       RaiseExc('Expected character (A-Z, a-z)');
-    Result := buf[0];
+    OldBuf := buf;
     Inc(buf);
-    Result := Result + GetString(['A'..'Z', 'a'..'z', '0'..'9', '.', '_', '-']);
+    SkipString(['A'..'Z', 'a'..'z', '0'..'9', '.', '_', '-']);
+    Result := GetString(OldBuf,buf-OldBuf);
   end;
 
 begin
@@ -966,14 +1016,14 @@ procedure TXMLReader.ResolveEntities(RootNode: TDOMNode);
       if Assigned(NextSibling) and (NextSibling.NodeType = TEXT_NODE) then
       begin
         TDOMCharacterData(PrevSibling).AppendData(
-	  TDOMCharacterData(NextSibling).Data);
+        TDOMCharacterData(NextSibling).Data);
-	RootNode.RemoveChild(NextSibling);
+        RootNode.RemoveChild(NextSibling);
       end
     end else
       if Assigned(NextSibling) and (NextSibling.NodeType = TEXT_NODE) then
       begin
         TDOMCharacterData(NextSibling).InsertData(0, Replacement);
-	RootNode.RemoveChild(EntityNode);
+        RootNode.RemoveChild(EntityNode);
       end else
         RootNode.ReplaceChild(Doc.CreateTextNode(Replacement), EntityNode);
   end;
@@ -987,15 +1037,15 @@ begin
     NextSibling := Node.NextSibling;
     if Node.NodeType = ENTITY_REFERENCE_NODE then
       if Node.NodeName = 'amp' then
-	ReplaceEntityRef(Node, '&')
+        ReplaceEntityRef(Node, '&')
       else if Node.NodeName = 'apos' then
-	ReplaceEntityRef(Node, '''')
+        ReplaceEntityRef(Node, '''')
       else if Node.NodeName = 'gt' then
-	ReplaceEntityRef(Node, '>')
+        ReplaceEntityRef(Node, '>')
       else if Node.NodeName = 'lt' then
         ReplaceEntityRef(Node, '<')
       else if Node.NodeName = 'quot' then
-	ReplaceEntityRef(Node, '"');
+        ReplaceEntityRef(Node, '"');
     Node := NextSibling;
   end;
 end;
@@ -1123,6 +1173,9 @@ end.
 
 {
   $Log$
+  Revision 1.2  2002/07/30 14:36:28  lazarus
+  MG: accelerated xmlread and xmlwrite
+
   Revision 1.1  2002/07/30 06:24:06  lazarus
   MG: added a faster version of TXMLConfig
 

components/codetools/laz_xmlwrite.pas

@@ -83,7 +83,7 @@ end;
 // -------------------------------------------------------------------
 
 type
-  TOutputProc = procedure(s: String);
+  TOutputProc = procedure(const Buffer; Count: Longint);
 
 var
   f: ^Text;
@@ -91,30 +91,56 @@ var
   wrt, wrtln: TOutputProc;
   InsideTextNode: Boolean;
 
-
+procedure Text_Write(const Buffer; Count: Longint);
-procedure Text_Write(s: String);
+var s: string;
 begin
-  Write(f^, s);
+  if Count>0 then begin
+    SetLength(s,Count);
+    System.Move(Buffer,s[1],Count);
+    Write(f^, s);
+  end;
 end;
 
-procedure Text_WriteLn(s: String);
+procedure Text_WriteLn(const Buffer; Count: Longint);
+var s: string;
 begin
-  WriteLn(f^, s);
+  if Count>0 then begin
+    SetLength(s,Count);
+    System.Move(Buffer,s[1],Count);
+    WriteLn(f^, s);
+  end;
 end;
 
-procedure Stream_Write(s: String);
+procedure Stream_Write(const Buffer; Count: Longint);
 begin
-  if Length(s) > 0 then
+  if Count > 0 then
-    stream.Write(s[1], Length(s));
+    stream.Write(Buffer, Count);
 end;
 
-procedure Stream_WriteLn(s: String);
+procedure Stream_WriteLn(const Buffer; Count: Longint);
 begin
-  if Length(s) > 0 then
+  if Count > 0 then
-    stream.Write(s[1], Length(s));
+    stream.Write(Buffer, Count);
   stream.WriteByte(10);
 end;
 
+procedure wrtStr(s: string);
+begin
+  if s<>'' then
+    wrt(s[1],length(s));
+end;
+
+procedure wrtStrLn(s: string);
+begin
+  if s<>'' then
+    wrtln(s[1],length(s));
+end;
+
+procedure wrtChr(c: char);
+begin
+  wrt(c,1);
+end;
+
 
 // -------------------------------------------------------------------
 //   Indent handling
@@ -160,36 +186,43 @@ begin
   begin
     if s[EndPos] in SpecialChars then
     begin
-      wrt(Copy(s, StartPos, EndPos - StartPos));
+      wrt(s[StartPos],EndPos - StartPos);
       SpecialCharCallback(s[EndPos]);
       StartPos := EndPos + 1;
     end;
     Inc(EndPos);
   end;
   if EndPos > StartPos then
-    wrt(Copy(s, StartPos, EndPos - StartPos));
+    wrt(s[StartPos], EndPos - StartPos);
 end;
 
 procedure AttrSpecialCharCallback(c: Char);
+const
+  QuotStr = '&quot;';
+  AmpStr = '&amp;';
 begin
   if c = '"' then
-    wrt('&quot;')
+    wrt(QuotStr, length(QuotStr))
   else if c = '&' then
-    wrt('&amp;')
+    wrt(AmpStr, length(AmpStr))
   else
-    wrt(c);
+    wrt(c,1);
 end;
 
 procedure TextnodeSpecialCharCallback(c: Char);
+const
+  ltStr = '&lt;';
+  gtStr = '&gt;';
+  AmpStr = '&amp;';
 begin
   if c = '<' then
-    wrt('&lt;')
+    wrt(ltStr, length(ltStr))
   else if c = '>' then
-    wrt('&gt;')
+    wrt(gtStr, length(gtStr))
   else if c = '&' then
-    wrt('&amp;')
+    wrt(AmpStr, length(AmpStr))
   else
-    wrt(c);
+    wrt(c,1);
 end;
 
 
@@ -205,31 +238,35 @@ var
   s: String;
 begin
   if not InsideTextNode then
-    wrt(Indent);
+    wrtStr(Indent);
-  wrt('<' + node.NodeName);
+  wrtChr('<');
+  wrtStr(node.NodeName);
   for i := 0 to node.Attributes.Length - 1 do
   begin
     attr := node.Attributes.Item[i];
-    wrt(' ' + attr.NodeName + '=');
+    wrtChr(' ');
+    wrtStr(attr.NodeName);
+    wrtChr('=');
     s := attr.NodeValue;
     // !!!: Replace special characters in "s" such as '&', '<', '>'
-    wrt('"');
+    wrtChr('"');
     ConvWrite(s, AttrSpecialChars, @AttrSpecialCharCallback);
-    wrt('"');
+    wrtChr('"');
   end;
   Child := node.FirstChild;
-  if Child = nil then
+  if Child = nil then begin
-    if InsideTextNode then
+    if InsideTextNode then begin
-      wrt('/>')
+      wrtChr('/'); wrtChr('>');
-    else
+    end else begin
-      wrtln('/>')
+      wrtChr('/'); wrtln('>',1);
-  else
+    end;
+  end else
   begin
     SavedInsideTextNode := InsideTextNode;
     if InsideTextNode or Child.InheritsFrom(TDOMText) then
-      wrt('>')
+      wrtChr('>')
     else
-      wrtln('>');
+      wrtln('>',1);
     IncIndent;
     repeat
       if Child.InheritsFrom(TDOMText) then
@@ -239,13 +276,15 @@ begin
     until child = nil;
     DecIndent;
     if not InsideTextNode then
-      wrt(Indent);
+      wrtStr(Indent);
     InsideTextNode := SavedInsideTextNode;
-    s := '</' + node.NodeName + '>';
+    wrtChr('<');
+    wrtChr('/');
+    wrtStr(node.NodeName);
     if InsideTextNode then
-      wrt(s)
+      wrtChr('>')
     else
-      wrtln(s);
+      wrtln('>',1);
   end;
 end;
 
@@ -264,14 +303,16 @@ end;
 procedure WriteCDATA(node: TDOMNode);
 begin
   if InsideTextNode then
-    wrt('<![CDATA[' + node.NodeValue + ']]>')
+    wrtStr('<![CDATA[' + node.NodeValue + ']]>')
   else
-    wrtln(Indent + '<![CDATA[' + node.NodeValue + ']]>')
+    wrtStrln(Indent + '<![CDATA[' + node.NodeValue + ']]>')
 end;
 
 procedure WriteEntityRef(node: TDOMNode);
 begin
-  wrt('&' + node.NodeName + ';');
+  wrtChr('&');
+  wrtStr(node.NodeName);
+  wrtChr(';');
 end;
 
 procedure WriteEntity(node: TDOMNode);
@@ -281,23 +322,23 @@ begin
 end;
 
 procedure WritePI(node: TDOMNode);
-var
-  s: String;
 begin
-  s := '<!' + TDOMProcessingInstruction(node).Target + ' ' +
+  wrtChr('<'); wrtChr('!');
-    TDOMProcessingInstruction(node).Data + '>';
+  wrtStr(TDOMProcessingInstruction(node).Target);
-  if InsideTextNode then
+  wrtChr(' ');
-    wrt(s)
+  wrtStr(TDOMProcessingInstruction(node).Data);
-  else
+  wrtChr('>');
-    wrtln(Indent + s);
+  if not InsideTextNode then
+    wrtStrln('');
 end;
 
 procedure WriteComment(node: TDOMNode);
 begin
-  if InsideTextNode then
+  wrtStr('<!--');
-    wrt('<!--' + node.NodeValue + '-->')
+  wrtStr(node.NodeValue);
-  else
+  wrtStr('-->');
-    wrtln(Indent + '<!--' + node.NodeValue + '-->')
+  if not InsideTextNode then
+    wrtStrln('');
 end;
 
 procedure WriteDocument(node: TDOMNode);
@@ -335,19 +376,19 @@ var
   Child: TDOMNode;
 begin
   InitWriter;
-  wrt('<?xml version="');
+  wrtStr('<?xml version="');
   if Length(doc.XMLVersion) > 0 then
-    wrt(doc.XMLVersion)
+    wrtStr(doc.XMLVersion)
   else
-    wrt('1.0');
+    wrtStr('1.0');
-  wrt('"');
+  wrtChr('"');
   if Length(doc.Encoding) > 0 then
-    wrt(' encoding="' + doc.Encoding + '"');
+    wrtStr(' encoding="' + doc.Encoding + '"');
-  wrtln('?>');
+  wrtStrln('?>');
 
   if Length(doc.StylesheetType) > 0 then
     // !!!: Can't handle with HRefs which contain special chars (" and so on)
-    wrtln(Format('<?xml-stylesheet type="%s" href="%s"?>',
+    wrtStrln(Format('<?xml-stylesheet type="%s" href="%s"?>',
       [doc.StylesheetType, doc.StylesheetHRef]));
 
   indent := '';
@@ -361,17 +402,30 @@ begin
 end;
 
 
+procedure WriteXMLMemStream(doc: TXMLDocument);
+// internally used by the WriteXMLFile procedures
+begin
+  Stream:=TMemoryStream.Create;
+  WriteXMLFile(doc,Stream);
+  Stream.Position:=0;
+end;
+
 // -------------------------------------------------------------------
 //   Interface implementation
 // -------------------------------------------------------------------
 
 procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
+var fs: TFileStream;
 begin
-  Stream := TFileStream.Create(AFileName, fmCreate);
+  // write first to memory buffer and then as one whole block to file
-  wrt := @Stream_Write;
+  WriteXMLMemStream(doc);
-  wrtln := @Stream_WriteLn;
+  try
-  RootWriter(doc);
+    fs := TFileStream.Create(AFileName, fmCreate);
-  Stream.Free;
+    fs.CopyFrom(Stream,Stream.Size);
+    fs.Free;
+  finally
+    Stream.Free;
+  end;
 end;
 
 procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
@@ -425,6 +479,9 @@ end.
 
 {
   $Log$
+  Revision 1.2  2002/07/30 14:36:28  lazarus
+  MG: accelerated xmlread and xmlwrite
+
   Revision 1.1  2002/07/30 06:24:06  lazarus
   MG: added a faster version of TXMLConfig