/// unit obsahujuci algoritmy na porovnavanie stromov
{$I main.inc}
unit treedist;

interface

uses main,LCS,constants,hashmap,structures,simple,Classes,tables,forms;

const
      /// konstanta F pre FMES algortimus
      LEAF_EQ_CONST_F = 0;
      /// konstanta T pre FMES algortimus
      INTNODE_EQ_CONST_T = 0;

type PTreeCompareResult = ^TTreeCompareResult;
     /// record popisujuci vysledok porovnavania stromov TreeScore metodou
     TTreeCompareResult = record
       score: Integer;
       nd,ni,nm,nc,nmove: Integer;
     end;

  procedure freeSubTree(var p: PToken);
  function toStringSubTree(p: PToken; bComplex: Boolean = false; bPos: Boolean = true; bIndent: Boolean = true; ttable: TStrIntHashMap = nil; stable: TStrIntHashMap = nil): xString;
  function ParseTreeToTStringList(root: PToken; indent: Integer = 0): TStringList;
  function ParallelPreOrder(root1: PToken; size1: Integer; root2: PToken; size2: Integer; L: PIntList; LRuleTable: TRuleTable; IndentSet,HighlightSet: TIntIntHashSet; var Lines1,Lines2: TStringList; indent: Integer = 0; bBkColor: Boolean = true; bWantResult: Boolean = false): PTreeCompareResult;
  function ParallelPrinting(root1: PToken; size1: Integer; root2: PToken; size2: Integer; L: PIntList; LRuleTable: TRuleTable; IndentSet,HighlightSet: TIntIntHashSet; var Lines1,Lines2: TStringList; indent: Integer = 0): PTreeCompareResult;

  procedure fillInOrderArrays(root1: PToken;size1: Integer;root2: PToken;size2: Integer);
  function compareTrees(root1: PToken;size1: Integer;root2: PToken;size2: Integer): PTreeCompareResult;
  function compareTrees2(root1: PToken;size1: Integer;root2: PToken;size2: Integer): PTreeCompareResult;
  function compareTrees3(root1: PToken;size1: Integer;root2: PToken;size2: Integer; ruletable: TRuleTable; var L: PIntList; bAdvanced: Boolean = false; bTopDown: Boolean = false): PTreeCompareResult;

var ia1,ia2: array of PToken;

implementation

uses SysUtils,Windows,memorymanager,StrUtils,filediff,Graphics,filereader,grammaredit,mainframe,crc32,logframe;

var pa1,pa2: array of PToken;
    Mtemp: TIntIntHashSet;

/// procedura uvolnujuca podstrom zakoreneny vo vrchole p z pamate
procedure freeSubTree(var p: PToken);
begin
  if p = nil then
    Exit;
//  writeln('Node ',Integer(p),': ',p.tokentype,' ',p.value,' (',p.startp,' - ',p.endp,')',' | ',Integer(p.child),' -> ',Integer(p.sibling));
  freeSubTree(p.child);
  freeSubTree(p.sibling);
//  writeln('Killing node ',Integer(p));
  dispose(p);
//  writeln('Killed...');
end;

/// funkcia vypisujuca podstrom zakoreneny vo vrchole p do stringu, ak je bComplex true, tak bude vypis komplexnejsi;
/// ak je bPos true, tak okrem vrcholov vypisuje ak ich poziciu vo vstupnom subore;
/// ak je bIndent true, tak pri vypise aj odsadzuje vrcholy podla hlbky v strome;
/// ttable, stable su tabulky sluziace iba na zistenie mena terminalu/neterminalu na zaklade jeho typu
function toStringSubTree(p: PToken; bComplex: Boolean = false; bPos: Boolean = true; bIndent: Boolean = true; ttable: TStrIntHashMap = nil; stable: TStrIntHashMap = nil): xString;
  function _s(p: PToken; i: Integer): xString;
  var j: Integer;
  begin
    result := '';
    if p = nil then
      Exit;
    if bIndent then
      for j := 1 to i do begin
        result := result + '  ';
      end;
    if bComplex then begin
      if bPos then
        result := result + 'Node ' + IntToStr(Integer(p)) + ': ' + IntToStr(p.tokentype) + ' ' + p.value + ' (' + IntToStr(p.startp) + ' - ' + IntToStr(p.endp)  + ')' + ' | ' + IntToStr(Integer(p.child)) + ' -> ' + IntToStr(Integer(p.sibling)) + EOL
      else
        result := result + 'Node ' + IntToStr(Integer(p)) + ': ' + IntToStr(p.tokentype) + ' ' + p.value + ' | ' + IntToStr(Integer(p.child)) + ' -> ' + IntToStr(Integer(p.sibling)) + EOL;
    end
    else begin
      if bPos then
        result := result + IntToStr(p.tokentype) + ' (' + IntToStr(p.startp) + ' - ' + IntToStr(p.endp)  + ')' + EOL
      else
        result := result + IntToStr(p.tokentype) + EOL;
    end;
    result := result + _s(p.child,i+1);
    result := result + _s(p.sibling,i);
  end;
  function _t(p: PToken; i: Integer): xString;
  var j: Integer;
      S: xString;
      b: Boolean;
  begin
    result := '';
    if p = nil then
      Exit;
    if bIndent then
      for j := 1 to i do begin
        result := result + '  ';
      end;
    if p.tokentype > MAX_TERMINAL then
      S := stable.findByValue(p.tokentype,b)
    else
      S := ttable.findByValue(p.tokentype,b);
    result := result + '<' + IntToStr(p._id) + '> ';//+ ',' + IntToStr(p._inorder) + '> ';
    if bPos then begin
      if bComplex then begin
        if b then
          result := result + 'Node ' + IntToStr(Integer(p)) + ': ' + S + ' [' + IntToStr(p.tokentype) + ']' + ' ' + p.value + ' (' + IntToStr(p.startp) + ' - ' + IntToStr(p.endp)  + ')' + ' | ' + IntToStr(Integer(p.child)) + ' -> ' + IntToStr(Integer(p.sibling)) + EOL
        else
          result := result + 'Node ' + IntToStr(Integer(p)) + ': ' + IntToStr(p.tokentype) + ' ' + p.value + ' (' + IntToStr(p.startp) + ' - ' + IntToStr(p.endp)  + ')' + ' | ' + IntToStr(Integer(p.child)) + ' -> ' + IntToStr(Integer(p.sibling)) + EOL;
      end
      else begin
        if b then
          result := result + S + ' [' + IntToStr(p.tokentype) + ']' + ' (' + IntToStr(p.startp) + ' - ' + IntToStr(p.endp)  + ')' + EOL
        else
          result := result + IntToStr(p.tokentype) + ' (' + IntToStr(p.startp) + ' - ' + IntToStr(p.endp)  + ')' + EOL;
      end;
    end
    else begin
      if bComplex then begin
        if b then
          result := result + 'Node ' + IntToStr(Integer(p)) + ': ' + S + ' [' + IntToStr(p.tokentype) + ']' + ' ' + p.value + ' | ' + IntToStr(Integer(p.child)) + ' -> ' + IntToStr(Integer(p.sibling)) + EOL
        else
          result := result + 'Node ' + IntToStr(Integer(p)) + ': ' + IntToStr(p.tokentype) + ' ' + p.value + ' | ' + IntToStr(Integer(p.child)) + ' -> ' + IntToStr(Integer(p.sibling)) + EOL;
      end
      else begin
        if b then
          result := result + S + ' [' + IntToStr(p.tokentype) + ']' + EOL
        else
          result := result + IntToStr(p.tokentype) + EOL;
      end;
    end;
    result := result + _t(p.child,i+1);
    result := result + _t(p.sibling,i);
  end;
begin
  if (ttable = nil) or (stable = nil) then
    result := _s(p,0)
  else
    result := _t(p,0);
end;

/// funkcia na vypis podstromu zakorenenom vo vrchole root do zoznamu stringov;
/// indent urcuje pociatocne odsadenie
function ParseTreeToTStringList(root: PToken; indent: Integer = 0): TStringList;
var bNewLine: Boolean;
    lineno: Integer;
    S: xString;

  procedure _pre(p: PToken; parent: PToken; ind: Integer = 0);
  begin
    if p = nil then begin
      Exit;
    end;
//    p._parent := parent;

    if p.tokentype < MAX_TERMINAL then begin
      if bNewLine then begin
        S := dupestring(' ',ind);
        bNewLine := false;
      end;
      S := S + p.value + ' ';
      if p.value = ';' then begin
        if (parent = nil) or (not (parent.tokentype = 1000000032)) then begin
          result.add(S);
          lineno := lineno + 1;
          S := '';
          bNewLine := true;
        end;
      end
      else begin
      end;
    end
    else begin
      parent := p;
      p := p.child;
      while p <> nil do begin
        if p.tokentype = 1000000012 then begin
          ind := ind + 2;
          result.add(S);
          lineno := lineno + 1;
          S := '';
          bNewLine := true;
        end;
        _pre(p,parent,ind);
        if p.tokentype = 1000000012 then begin
          ind := ind - 2;
        end;
        p := p.sibling;
      end;
    end;
  end;

begin
  lineno := 0;
  S := '';
  result := TStringList.create;
  bNewLine := false;
  _pre(root,nil,indent);
  if S <> '' then
    result.add(S);
end;

/// procedura, ktora naplni globalne polia preorderovym usporiadanim vrcholov vstupnych stromov;
/// root1 je koren vstupneho stromu s velkostou size1;
/// root2 je koren vstupneho stromu s velkostou size2
/// popri tom este pre kazdy vrchol nastavi jeho otca, jeho hlbku v strome a jeho poziciu v konkretnom poli
procedure fillPreOrderArrays(root1: PToken;size1: Integer;root2: PToken;size2: Integer);  //1 based!!!, root should NOT have any siblings
var i,j: Integer;

  procedure preorder(node: PToken; var a: array of PToken; depth: Integer);
  var tempnode: PToken;
  begin
    if node = nil then
      Exit;

    node._inorder := depth;
    node._id := i;
    a[i] := node;
    i := i + 1;

    if node.child <> nil then begin
      node.child._parent := node;
      preorder(node.child,a,depth+1);
    end;

    if node.child <> nil then begin
      tempnode := node.child.sibling;
      while tempnode <> nil do begin
        tempnode._parent := node;
        preorder(tempnode,a,depth+1);
        tempnode := tempnode.sibling;
      end;
    end;

  end;

begin
  SetLength(ia1,size1+1);
  SetLength(ia2,size2+1);
  i := 1;
  preorder(root1,ia1,0);
  i := 1;
  preorder(root2,ia2,0);
end;

/// procedura, ktora naplni globalne polia postorderovym usporiadanim vrcholov vstupnych stromov;
/// root1 je koren vstupneho stromu s velkostou size1;
/// root2 je koren vstupneho stromu s velkostou size2
/// popri tom este pre kazdy vrchol nastavi jeho otca, pocet jeho potomkov a hashovaciu hodnotu reprezentujucu podstrom zakoreneny v danom vrchole
procedure fillSimplePostOrderChildCountAndSize(root1: PToken;size1: Integer;root2: PToken;size2: Integer);
var i,j: Integer;
    B: array of Integer;

  procedure postorder(node: PToken);
  var tempnode: PToken;
      leftmostchildindex: Integer;
      cc1,i1: Integer;
      t: PToken;
      value: DWORD;
  begin
    if node = nil then
      Exit;

    leftmostchildindex := i;
    cc1 := 0;

    //calculate path signature
    SetLength(B,2);
    if node._parent <> nil then
      B[0] := node._parent._id
    else
      B[0] := 0;

    B[1] := node.tokentype;
(*    j := 1;
    t := node.child;
    while t <> nil do begin
      B[j] := t._hash;
      t := t.sibling;
      j := j + 1;
    end;*)
    value := $FFFFFFFF;
    CalcCRC32(B,(2) shl 2,value);
    //end of path signature calculation
    node._id := value;


    if node.child <> nil then begin
      node.child._parent := node;
      postorder(node.child);
      cc1 := cc1 + 1;
//      node._id := node._id + node.child._id;
    end;

    if node.child <> nil then begin
      tempnode := node.child.sibling;
      while tempnode <> nil do begin
        tempnode._parent := node;
        postorder(tempnode);
        cc1 := cc1 + 1;
//        node._id := node._id + tempnode._id;
        tempnode := tempnode.sibling;
      end;
    end;

    node._inorder := cc1; //childcount

    //calculate hash
    SetLength(B,cc1+1);
    B[0] := node.tokentype;
    j := 1;
    t := node.child;
    while t <> nil do begin
      B[j] := t._hash;
      t := t.sibling;
      j := j + 1;
    end;
    value := $FFFFFFFF;
    CalcCRC32(B,(cc1+1) shl 2,value);
    //end of hash calculation
    node._hash := value;

//    node._id := i - leftmostchildindex + 1;  //size of subtree

    i := i + 1;
  end;

begin
  i := 1;
  postorder(root1);
  i := 1;
  postorder(root2);
  B := nil;
end;

/// procedura, ktora naplni globalne polia postorderovym usporiadanim vrcholov vstupnych stromov;
/// root1 je koren vstupneho stromu s velkostou size1;
/// root2 je koren vstupneho stromu s velkostou size2
/// popri tom este pre kazdy vrchol nastavi jeho otca, pocet jeho potomkov, hashovaciu hodnotu reprezentujucu podstrom zakoreneny v danom vrchole
/// a skore daneho podstromu
procedure fillPostOrderArrays(root1: PToken;size1: Integer;root2: PToken;size2: Integer; ruletable: TRuleTable = nil);  //1 based!!!, root should NOT have any siblings
var i,j: Integer;
    B: array of Integer;
    hashset: TIntHashSet;

  procedure postorder(node: PToken; var a: array of PToken; depth: Integer);
  var tempnode: PToken;
      leftmostchildindex: Integer;
      cc1,i1: Integer;
      t: PToken;
      value: DWORD;
  begin
    if node = nil then
      Exit;

    leftmostchildindex := i;
    cc1 := 0;
    node._id := 0;

    if node.child <> nil then begin
      node.child._parent := node;
      postorder(node.child,a,depth+1);
      cc1 := cc1 + 1;
      node._id := node._id + node.child._id;
    end;

    if node.child <> nil then begin
      tempnode := node.child.sibling;
      while tempnode <> nil do begin
        tempnode._parent := node;
        postorder(tempnode,a,depth+1);
        cc1 := cc1 + 1;
        node._id := node._id + tempnode._id;
        tempnode := tempnode.sibling;
      end;
    end;

    node._inorder := cc1; //childcount
    //i - leftmostchildindex + 1;  //size of subtree

    //calculate cost
    if (ruletable = nil) then begin
      j := 1;
    end
    else begin
      if (ruletable.FEquivalentIndices = nil) then begin
        j := ruletable.FDefEqScore;
      end
      else begin
        if ruletable.FEquivalentIndices.get(node.tokentype,i1) then begin
          if ruletable.FEquivalenceSets.get(i1,Integer(hashset)) then
            j := hashset.tag
          else
            j := ruletable.FDefEqScore;
        end
        else begin
          j := ruletable.FDefEqScore;
        end
      end;
    end;
    node._id := node._id + j;
    //end of cost calculation

    //calculate hash
    SetLength(B,cc1+1);
    B[0] := node.tokentype;
    j := 1;
    t := node.child;
    while t <> nil do begin
      B[j] := t._hash;
      t := t.sibling;
      j := j + 1;
    end;
    value := $FFFFFFFF;
    CalcCRC32(B,(cc1+1) shl 2,value);
    //end of hash calculation
    node._hash := value;

    a[i] := node;
    i := i + 1;
  end;

begin
  SetLength(pa1,size1+1);
  SetLength(pa2,size2+1);
  i := 1;
  postorder(root1,pa1,0);
  i := 1;
  postorder(root2,pa2,0);
  B := nil;
end;

/// procedura, ktora naplni globalne polia postorderovym usporiadanim vrcholov vstupnych stromov;
/// root1 je koren vstupneho stromu s velkostou size1;
/// root2 je koren vstupneho stromu s velkostou size2,
/// popri tom este pre kazdy vrchol nastavi jeho otca, pocet jeho potomkov, hashovaciu hodnotu reprezentujucu podstrom zakoreneny v danom vrchole
/// a skore ekvivalencii v danom podstromu
procedure fillPostOrderArraysWithHashEqValues(root1: PToken;size1: Integer;root2: PToken;size2: Integer; ruletable: TRuleTable = nil);  //1 based!!!, root should NOT have any siblings
var i,j: Integer;
    B: array of Integer;
    hashset: TIntHashSet;
    bLowerCase: Boolean;

  procedure postorder(node: PToken; var a: array of PToken; depth: Integer);
  var tempnode: PToken;
      leftmostchildindex: Integer;
      cc1,i1: Integer;
      t: PToken;
      value: DWORD;
  begin
    if node = nil then
      Exit;

    leftmostchildindex := i;
    cc1 := 0;
    node._id := 0;

    if node.child <> nil then begin
      node.child._parent := node;
      postorder(node.child,a,depth+1);
      cc1 := cc1 + 1;
      node._id := node._id + node.child._id;
    end;

    if node.child <> nil then begin
      tempnode := node.child.sibling;
      while tempnode <> nil do begin
        tempnode._parent := node;
        postorder(tempnode,a,depth+1);
        cc1 := cc1 + 1;
        node._id := node._id + tempnode._id;
        tempnode := tempnode.sibling;
      end;
    end;

    node._inorder := cc1; //childcount
    //i - leftmostchildindex + 1;  //size of subtree

    //calculate cost
    if (ruletable = nil) then begin
      j := 1;
    end
    else begin
      if (ruletable.FEquivalentIndices = nil) then begin
        j := ruletable.FDefEqScore + ruletable.FDefEqScore2;
      end
      else begin
        if ruletable.FEquivalentIndices.get(node.tokentype,i1) then begin
          if ruletable.FEquivalenceSets.get(i1,Integer(hashset)) then
            j := hashset.tag + hashset.tag2
          else
            j := ruletable.FDefEqScore + ruletable.FDefEqScore2;
        end
        else begin
          j := ruletable.FDefEqScore + ruletable.FDefEqScore2;
        end
      end;
    end;
    node._id := node._id + j;
    //end of cost calculation

    //calculate hash
    SetLength(B,cc1+1);
    if node.tokentype <= MAX_TERMINAL then begin
      value := $FFFFFFFF;

      if bLowerCase then
        B[0] := StringToCRC32(AnsiLowerCase(node.value),nil,true)
      else
        B[0] := StringToCRC32(node.value,nil,true);

    end
    else
      B[0] := node.tokentype;
    j := 1;
    t := node.child;
    while t <> nil do begin
      B[j] := t._hash;
      t := t.sibling;
      j := j + 1;
    end;
    value := $FFFFFFFF;
    CalcCRC32(B,(cc1+1) shl 2,value);
    //end of hash calculation
    node._hash := value;

    a[i] := node;
    i := i + 1;
  end;

begin
  bLowerCase := ruleTable.getCaseSensitivity;

  SetLength(pa1,size1+1);
  SetLength(pa2,size2+1);
  i := 1;
  postorder(root1,pa1,0);
  i := 1;
  postorder(root2,pa2,0);
  B := nil;
end;

/// funkcia vypisujuca vstupne stromy a vyznacujuca rozdiely medzi nimi, s vyznacovanim syntaxe (ale nerobi formatovanie textu)
/// snazi sa napodobnit formatovanie vo vstupnych suboroch,
/// vstupy su nasledovne:
/// root1 je koren vstupneho stromu s velkostou size1;
/// root2 je koren vstupneho stromu s velkostou size2;
/// L je vstupne mapovanie vrcholov oboch stromov;
/// LRuleTable je tabulka pravidiel, ktora vsak obsahuje aj mnoziny mnozin tokenov definujuce skore pre zhodne,ekvivalentne a podobne tokeny;
/// IndentSet je mnozina mnozin definujuca formatovanie textu nepouzivana v tejto funkcii;
/// HighlightSet je mnozina mnozin definujuca vyznacovanie syntaxe;
/// Lines1,Lines2 su vystupne zoznamy stringov s definovanymi farebnymi odlisnostami, pridanymi volnymi riadkami a synchronizovanymi vypismi;
/// indent je pociatocne odsadenie;
/// vystupom je vysledok porovnavania aj s konkretnym poctom vlozeni,vymazani,modifikacii tokenov
function ParallelPrinting(root1: PToken; size1: Integer; root2: PToken; size2: Integer; L: PIntList; LRuleTable: TRuleTable; IndentSet,HighlightSet: TIntIntHashSet; var Lines1,Lines2: TStringList; indent: Integer = 0): PTreeCompareResult;
var bNewLine: Boolean;
    lineno: Integer;
    S1,S2,S: xString;
    ln1,ln2: PIntNode;
    curr1,curr2: PToken;
    QT,QT2,Q1,Q2,Qtemp: TQueueStack;
    index1,index2: Integer;
    colorstrips1,colorstrips2: TSortedDLinkedList;
    pdef1,pdef2: PTokenData;
    pdefhighlight: PTokenHighlight;
    diffres: Integer;
    reader1,reader2: TSimpleReader;
    lexer1,lexer2: TLexer;
    b: Boolean;
    WS: Integer;
    CL,C1,C2: Integer;
    phighlight1,phighlight2: PTokenHighlight;
    c,tc1,tc2: TColor;
    ts1,ts2: Integer;
    cstart1,cstart2: Integer;
    clen1,clen2: Integer;
    diffresult: Integer;
    ch,cd,ci,cm: Integer;

  procedure _init;
  var b1,b2: Boolean;
  begin
    b1 := false;
    if highlightSet <> nil then begin
      b1 := highlightSet.get(0,Integer(pdefhighlight));
    end;
    if (highlightSet = nil) or (not b1) then begin
      new(pdefhighlight);
      pdefhighlight.tc := TCOLOR_DEFAULT;
      pdefhighlight.bc := COLOR_TEXTBACKGROUND;
      pdefhighlight.style := 0;
    end;
    WS := LRuleTable.getWSTerminal;
    LRuleTable.getComments(CL,C1,C2);
  end;

  procedure _addlines(ind: Integer);
  var pline1,pline2: PLineRecord;
      Stemp: xString;
  begin
    Application.ProcessMessages;
    if FGlobalHalt then
      Exit;
    new(pline1);
    pline1.diffres := diffres;
    pline1.colorStrips := colorStrips1;
    Lines1.AddObject(S1,TObject(pline1));
{$IFDEF DEBUG1}
    writeln(S1);
{$ENDIF}
    new(pline2);
    pline2.diffres := diffres;
    pline2.colorStrips := colorStrips2;
    Lines2.AddObject(S2,TObject(pline2));
    colorStrips1 := TSortedDLinkedList.create;
    colorStrips2 := TSortedDLinkedList.create;
    diffres := ES_MATCH;
    S1 := '';
    S2 := '';
  end;

  function _commonWS(str1,str2: xString): xString;
  var i1,i2: Integer;
  begin
    i1 := 1; i2 := 1;
    while (i1 <= Length(str1)) or (i2 <= Length(str2)) do begin
      if ((i1 <= Length(str1)) and (i2 <= Length(str2))) and (str1[i1] = str2[i2]) then begin
        result := result + str1[i1];
        if str1[i1] = SET_EOLWS then begin
          _addlines(0);
          diffres := ES_MATCH;
        end;
        Inc(i1);
        Inc(i2);
      end
      else if (i1 <= Length(str1)) and (str1[i1] <> SET_EOLWS) then begin
        result := result + str1[i1];
        Inc(i1);
      end
      else if (i2 <= Length(str2)) and (str2[i2] <> SET_EOLWS) then begin
        result := result + str2[i2];
        Inc(i2);
      end;
    end;
  end;

  procedure _replaceTabs(var str: xString; from: Integer);
  var i: Integer;
  begin
    clearGCA;
    for i := 1 to Length(str) do begin
      if i >= from then begin
        if str[i] = SET_TABCHAR then
          addStringtoGCA(dupestring(' ',TAB_SPACES))
        else if str[i] = SET_EOLWS then
          addtoGCA(SET_EOLWS)
        else if str[i] <> SET_EOLFILLER then
          addtoGCA(str[i]);
      end
      else begin
        addtoGCA(str[i]);
      end;
    end;
    toStringGCA(str);
  end;

  procedure _correctComments(str1,str2: xString);
  var i,j: Integer;
      string1,string2: xString;
      Stemp: xString;
      i1,i2: Integer;
      key1,key2: Integer;
      cend1,cend2: Integer;
      bNewLine: Boolean;
  begin
    _replaceTabs(str1,cstart1);
    _replaceTabs(str2,cstart2);
    i1 := 0; i2 := 0;
    bNewLine := false;
    key1 := cstart1;//Length(S1)+1;
    key2 := cstart2;//Length(S2)+1;
    string1 := copy(str1,1,Pred(cstart1));
    string2 := copy(str2,1,Pred(cstart2));
    clen1 := Length(str1);
    clen2 := Length(str2);
    cend1 := clen1;//(cstart1 + clen1 - 1);
    cend2 := clen2;//(cstart2 + clen2 - 1);
    i := cstart1;
    j := cstart2;
    while (i <= cend1) or (j <= cend2) do begin
      if (i and CYCLE_THRESHOLD = 0) or (j and CYCLE_THRESHOLD = 0) then begin
        Application.ProcessMessages;
      end;
      if FGlobalHalt then
        break;
      if (i <= cend1) and (j <= cend2) then begin
        if (str1[i] = str2[j]) then begin
         (* if str1[i] = #9 then begin
            Stemp := dupestring(' ',TAB_SPACES);
            string1 := string1 + Stemp;
            string2 := string2 + Stemp;
            i1 := i1 + TAB_SPACES;
            i2 := i2 + TAB_SPACES;
            bNewLine := false;
            i := i + 1;
            j := j + 1;
          end
          else if (str1[i] = SET_EOLFILLER) then begin
            i := i + 1;
            j := j + 1;
          end
          else*)
          if (str1[i] = SET_EOLWS) then begin
            S1 := string1;
            S2 := string2;
            colorStrips1.add(key1,i1,c,tc1,ts1);//phighlight1.tc,Integer(phighlight1.style));
            colorStrips2.add(key2,i2,c,tc2,ts2);//phighlight2.tc,Integer(phighlight2.style));
            _addlines(0);
            diffres := diffresult;
            key1 := 1;
            key2 := 1;
            string1 := '';
            string2 := '';
            bNewLine := true;
            i := i + 1;
            j := j + 1;
            i1 := 0;
            i2 := 0;
          end
          else begin
            string1 := string1 + str1[i];
            string2 := string2 + str2[j];
            i := i + 1;
            j := j + 1;
            i1 := i1 + 1;
            i2 := i2 + 1;
            bNewLine := false;
          end;
        end
        else begin
          if (str1[i] <> SET_EOLWS) and (str2[j] <> SET_EOLWS) then begin
            string1 := string1 + str1[i];
            string2 := string2 + str2[j];
            i := i + 1;
            j := j + 1;
            i1 := i1 + 1;
            i2 := i2 + 1;
            bNewLine := false;
          end
          else if (str2[j] <> SET_EOLWS) then begin
            string1 := string1 + ' ';
            string2 := string2 + str2[j];
            j := j + 1;
            i1 := i1 + 1;
            i2 := i2 + 1;
            bNewLine := false;
          end
          else begin
            string1 := string1 + str1[i];
            string2 := string2 + ' ';
            i := i + 1;
            i1 := i1 + 1;
            i2 := i2 + 1;
            bNewLine := false;
          end;
        end;
      end
      else if (i <= cend1) then begin
          if (str1[i] = SET_EOLWS) then begin
            S1 := string1;
            S2 := string2;
            colorStrips1.add(key1,i1,c,tc1,ts1);//phighlight1.tc,Integer(phighlight1.style));
            colorStrips2.add(key2,i2,c,tc2,ts2);//phighlight2.tc,Integer(phighlight2.style));
            _addlines(0);
            diffres := diffresult;
            key1 := 1;
            key2 := 1;
            string1 := '';
            string2 := '';
            bNewLine := true;
            i := i + 1;
//            j := j + 1;
            i1 := 0;
            i2 := 0;
          end
          else begin
            string1 := string1 + str1[i];
            string2 := string2 + ' ';
            i := i + 1;
            i1 := i1 + 1;
            i2 := i2 + 1;
            bNewLine := false;
          end;
      end
      else begin
          if (str2[j] = SET_EOLWS) then begin
            S1 := string1;
            S2 := string2;
            colorStrips1.add(key1,i1,c,tc1,ts1);//phighlight1.tc,Integer(phighlight1.style));
            colorStrips2.add(key2,i2,c,tc2,ts2);//phighlight2.tc,Integer(phighlight2.style));
            _addlines(0);
            diffres := diffresult;
            key1 := 1;
            key2 := 1;
            string1 := '';
            string2 := '';
            bNewLine := true;
//            i := i + 1;
            j := j + 1;
            i1 := 0;
            i2 := 0;
          end
          else begin
            string1 := string1 + ' ';
            string2 := string2 + str2[j];
            j := j + 1;
            i1 := i1 + 1;
            i2 := i2 + 1;
            bNewLine := false;
          end;
      end;
    end;
(*
      if (ord(str1[i]) < 32) or (ord(str2[i]) < 32) then begin
        if (ord(str1[i]) = 9) or (ord(str2[i]) = 9) then begin
          Stemp := dupestring(' ',TAB_SPACES);
          string1 := string1 + Stemp;
          string2 := string2 + Stemp;
          i1 := i1 + TAB_SPACES;
          i2 := i2 + TAB_SPACES;
          bNewLine := false;
        end
        else if (str1[i] = SET_EOLFILLER) or (str2[i] = SET_EOLFILLER) then begin
        end
        else if (str1[i] = SET_EOLWS) or (str2[i] = SET_EOLWS) then begin
          S1 := string1;
          S2 := string2;
          colorStrips1.add(key1,i1,c,tc1,ts1);//phighlight1.tc,Integer(phighlight1.style));
          colorStrips2.add(key2,i2,c,tc2,ts2);//phighlight2.tc,Integer(phighlight2.style));
          _addlines(0);
          diffres := diffresult;
          key1 := 1;
          key2 := 1;
          i1 := 0;
          i2 := 0;
          string1 := '';
          string2 := '';
          bNewLine := true;
        end;
      end
      else begin
        string1 := string1 + str1[i];
        string2 := string2 + str2[i];
        i1 := i1 + 1;
        i2 := i2 + 1;
        bNewLine := false;
      end;
    end;
*)
    if (i1 > 0) or (i2 > 0) then begin
      colorStrips1.add(key1,i1,c,tc1,ts1);//phighlight1.tc,Integer(phighlight1.style));
      colorStrips2.add(key2,i2,c,tc2,ts2);//phighlight2.tc,Integer(phighlight2.style));
    end;
    S1 := string1;
    S2 := string2;
    if bNewLine then
      diffres := ES_MATCH;
  end;

  function _putWS(str1,str2: xString; b: Boolean): xString;
  var index1,index2: Integer;
      Stemp: xString;
      key1,key2: Integer;
      i1,i2: Integer;
      m: Integer;
      colorI,colorD,tcolorI,tcolorD: TColor;
  begin
    if FDisableWSDiffsColoring then begin
      colorI := COLOR_NOT_COMPARED;
      colorD := COLOR_NOT_COMPARED;
      tcolorI := TCOLOR_NOT_COMPARED;
      tcolorD := TCOLOR_NOT_COMPARED;
    end
    else begin
      colorI := COLOR_INSERT;
      colorD := COLOR_DELETE;
      tcolorI := TCOLOR_INSERT;
      tcolorD := TCOLOR_DELETE;
    end;
    _replaceTabs(str1,1);
    _replaceTabs(str2,1);
    if b then begin
      _correctComments(S1,S2);
    end;
    index1 := 1;
    index2 := 1;
    key1 := Length(S1) + 1;
    key2 := Length(S2) + 1;
    i1 := 0;
    i2 := 0;
    while (index1 <= Length(str1)) or (index2 <= Length(str2)) do begin
      if (index1 and CYCLE_THRESHOLD = 0) or (index2 and CYCLE_THRESHOLD = 0) then begin
        Application.ProcessMessages;
      end;
      if FGlobalHalt then
        break;
      if ((index1 <= Length(str1)) and (index2 <= Length(str2))) and (str1[index1] = str2[index2]) then begin
        if str1[index1] = SET_EOLWS then begin
          if i1 > i2 then begin
            colorStrips1.add(key1+i1,i1-i2,colorD,tcolorD,TSTYLE_DEFAULT_INT);
            colorStrips2.add(key2+i1,i1-i2,colorD,tcolorD,TSTYLE_DEFAULT_INT);
            if (diffres <> ES_COMBINED) and (not FDisableWSDiffsColoring) then begin
              if diffres = ES_MATCH then
                diffres := ES_DELETE
              else if diffres <> ES_DELETE then
                diffres := ES_COMBINED;
            end;
          end
          else if i1 = i2 then begin
          end
          else begin
            colorStrips1.add(key1+i2,i2-i1,colorI,tcolorI,TSTYLE_DEFAULT_INT);
            colorStrips2.add(key2+i2,i2-i1,colorI,tcolorI,TSTYLE_DEFAULT_INT);
            if (diffres <> ES_COMBINED) and (not FDisableWSDiffsColoring) then begin
              if diffres = ES_MATCH then
                diffres := ES_INSERT
              else if diffres <> ES_INSERT then
                diffres := ES_COMBINED;
            end;
          end;
          _addlines(0);
          i1 := 0;
          i2 := 0;
          key1 := 1;
          key2 := 1;
          S1 := '';
          S2 := '';
        end
        else begin
          i1 := i1 + 1;
          i2 := i2 + 1;
          S1 := S1 + str1[index1];
          S2 := S2 + str2[index2];
        end
      end
      else if (index1 <= Length(str1)) and ((index2 > Length(str2)) or (str2[index2] <> SET_EOLWS)) then begin
        if str1[index1] = SET_EOLWS then begin
          if i1 > i2 then begin
            colorStrips1.add(key1+i1,i1-i2,colorD,tcolorD,TSTYLE_DEFAULT_INT);
            colorStrips2.add(key2+i1,i1-i2,colorD,tcolorD,TSTYLE_DEFAULT_INT);
            if (diffres <> ES_COMBINED) and (not FDisableWSDiffsColoring) then begin
              if diffres = ES_MATCH then
                diffres := ES_DELETE
              else if diffres <> ES_DELETE then
                diffres := ES_COMBINED;
            end;
          end
          else if i1 = i2 then begin
            colorStrips1.add(key1+i1,i1-i2,colorD,tcolorD,TSTYLE_DEFAULT_INT);
            colorStrips2.add(key2+i1,i1-i2,colorD,tcolorD,TSTYLE_DEFAULT_INT);
            if (diffres <> ES_COMBINED) and (not FDisableWSDiffsColoring) then begin
              if diffres = ES_MATCH then
                diffres := ES_DELETE
              else if diffres <> ES_DELETE then
                diffres := ES_COMBINED;
            end;
          end
          else begin
            colorStrips1.add(key1+i2,i2-i1,colorI,tcolorI,TSTYLE_DEFAULT_INT);
            colorStrips2.add(key2+i2,i2-i1,colorI,tcolorI,TSTYLE_DEFAULT_INT);
            if (diffres <> ES_COMBINED) and (not FDisableWSDiffsColoring) then begin
              if diffres = ES_MATCH then
                diffres := ES_INSERT
              else if diffres <> ES_INSERT then
                diffres := ES_COMBINED;
            end;
          end;
          _addlines(0);
          i1 := 0;
          i2 := 0;
          key1 := 1;
          key2 := 1;
          S1 := '';
          S2 := '';
        end
        else begin
          i1 := i1 + 1;
          S1 := S1 + str1[index1];
          S2 := S2 + str1[index1];
        end;
      end
      else if (index2 <= Length(str2)) then begin
        if str2[index2] = SET_EOLWS then begin
          if i1 > i2 then begin
            colorStrips1.add(key1+i1,i1-i2,colorD,tcolorD,TSTYLE_DEFAULT_INT);
            colorStrips2.add(key2+i1,i1-i2,colorD,tcolorD,TSTYLE_DEFAULT_INT);
            if (diffres <> ES_COMBINED) and (not FDisableWSDiffsColoring) then begin
              if diffres = ES_MATCH then
                diffres := ES_DELETE
              else if diffres <> ES_DELETE then
                diffres := ES_COMBINED;
            end;
          end
          else if i1 = i2 then begin
            colorStrips1.add(key1+i2,i2-i1,colorI,tcolorI,TSTYLE_DEFAULT_INT);
            colorStrips2.add(key2+i2,i2-i1,colorI,tcolorI,TSTYLE_DEFAULT_INT);
            if (diffres <> ES_COMBINED) and (not FDisableWSDiffsColoring) then begin
              if diffres = ES_MATCH then
                diffres := ES_INSERT
              else if diffres <> ES_INSERT then
                diffres := ES_COMBINED;
            end;
          end
          else begin
            colorStrips1.add(key1+i2,i2-i1,colorI,tcolorI,TSTYLE_DEFAULT_INT);
            colorStrips2.add(key2+i2,i2-i1,colorI,tcolorI,TSTYLE_DEFAULT_INT);
            if (diffres <> ES_COMBINED) and (not FDisableWSDiffsColoring) then begin
              if diffres = ES_MATCH then
                diffres := ES_INSERT
              else if diffres <> ES_INSERT then
                diffres := ES_COMBINED;
            end;
          end;
          _addlines(0);
          i1 := 0;
          i2 := 0;
          key1 := 1;
          key2 := 1;
          S1 := '';
          S2 := '';
        end
        else begin
          i2 := i2 + 1;
          S1 := S1 + str2[index2];
          S2 := S2 + str2[index2];
        end
      end;
      index1 := index1 + 1;
      index2 := index2 + 1;
    end;

    if i1 > i2 then begin
      colorStrips1.add(key1+i1,i1-i2,colorD,tcolorD,TSTYLE_DEFAULT_INT);
      colorStrips2.add(key2+i1,i1-i2,colorD,tcolorD,TSTYLE_DEFAULT_INT);
    end
    else if i1 = i2 then begin
    end
    else begin
      colorStrips1.add(key1+i2,i2-i1,colorI,tcolorI,TSTYLE_DEFAULT_INT);
      colorStrips2.add(key2+i2,i2-i1,colorI,tcolorI,TSTYLE_DEFAULT_INT);
    end;

(*      if ((index1 <= Length(str1)) and (index2 <= Length(str2))) and (str1[index1] = str2[index2]) then begin
        result := result + str1[index1];
        if ord(str1[index1]) < 32 then begin
        end
        else begin
          S1 := S1 + str1[index1];
          S2 := S2 + str2[index2];
          i1 := i1 + 1;
          i2 := i2 + 1;
        end;
        if str1[index1] = SET_EOLWS then begin
          colorStrips1.add(key1,i1,COLOR_MATCH,phighlight1.tc,Integer(phighlight1.style));
          colorStrips2.add(key2,i2,COLOR_MATCH,phighlight2.tc,Integer(phighlight2.style));
          _addlines(0);
          key1 := 1;
          key2 := 1;
          i1 := 0;
          i2 := 0;
        end;
        Inc(index1);
        Inc(index2);
      end
      else if (index1 <= Length(str1)) then begin
        result := result + str1[index1];
        if ord(str1[index1]) < 32 then begin
        end
        else begin
          S1 := S1 + str1[index1];
          S2 := S2 + str1[index1];
          i1 := i1 + 1;
          i2 := i2 + 1;
        end;
        if str1[index1] = SET_EOLWS then begin
          colorStrips1.add(key1,i1,COLOR_DELETE,phighlight1.tc,Integer(phighlight1.style));
          colorStrips2.add(key2,i2,COLOR_DELETE,phighlight2.tc,Integer(phighlight2.style));
          if diffres <> ES_COMBINED then begin
            if diffres = ES_MATCH then
              diffres := ES_DELETE
            else if diffres <> ES_DELETE then
              diffres := ES_COMBINED;
          end;
          _addlines(0);
          key1 := 1;
          key2 := 1;
          i1 := 0;
          i2 := 0;
        end;
        Inc(index1);
      end
      else if (index2 <= Length(str2)) then begin
        result := result + str2[index2];
        if ord(str2[index2]) < 32 then begin
        end
        else begin
          S1 := S1 + str2[index2];
          S2 := S2 + str2[index2];
          i1 := i1 + 1;
          i2 := i2 + 1;
        end;
        if str2[index2] = SET_EOLWS then begin
          colorStrips1.add(key1,i1,COLOR_INSERT,phighlight1.tc,Integer(phighlight1.style));
          colorStrips2.add(key2,i2,COLOR_INSERT,phighlight2.tc,Integer(phighlight2.style));
          if diffres <> ES_COMBINED then begin
            if diffres = ES_MATCH then
              diffres := ES_INSERT
            else if diffres <> ES_INSERT then
              diffres := ES_COMBINED;
          end;
          _addlines(0);
          key1 := 1;
          key2 := 1;
          i1 := 0;
          i2 := 0;
        end;
        Inc(index2);
      end;
*)
  end;

  function _getnonWStoken(lexer: TLexer; var p: PToken): xString;
  var str1: xString;
      u: PToken;
  begin
    str1 := '';
    u := lexer.getToken;
    while u.tokentype = WS do begin
      str1 := str1 + u.value;
      dispose(u);
      u := lexer.getToken;
    end;
    if p <> nil then begin
      dispose(p);
      p := nil;
    end;
    p := u;
    result := str1;
  end;
(*
  function _getnonWStokens(var p,r: PToken): xString;
  var str1,str2: xString;
      u,v: PToken;
  begin
    str1 := '';
    str2 := '';
    u := lexer1.getToken;
    while u.tokentype = WS do begin
      str1 := str1 + u.value;
      u := lexer1.getToken;
    end;
    v := lexer2.getToken;
    while v.tokentype = WS do begin
      str2 := str2 + v.value;
      v := lexer2.getToken;
    end;
    p := u; r := v;
    result := _putWS(str1,str2,false);
  end;
*)
  function _case_equal(s1,s2: xString): Boolean;
  begin
    //lexer1 and lexer2 should really have the same case sensitivity - so to simplify i use lexer1 as the common value
    if lexer1.getCaseSensitivity then begin
      s1 := AnsiLowerCase(s1);
      s2 := AnsiLowerCase(s2);
    end;
    result := (s1 = s2);
  end;

  procedure _addtoStrings(i1,i2: Integer; bComment: Boolean; Sx,Sy: xString);
  begin
    if (i2 > i1) and (not bComment) then begin
      S1 := S1 + Sx + dupestring(' ',i2 - i1);
    end
    else begin
      S1 := S1 + Sx;
    end;
    if (i1 > i2) and (not bComment) then begin
      S2 := S2 + Sy + dupestring(' ',i1 - i2);
    end
    else begin
      S2 := S2 + Sy;
    end;
  end;

  function _case_sense_equal(s1,s2: xString): Boolean;
  begin
    if not LRuleTable.getCaseSensitivity then begin
      s1 := AnsiLowerCase(s1);
      s2 := AnsiLowerCase(s2);
    end;
    result := (s1 = s2);
  end;

  procedure _walk;
  var k1,k2: Integer;
      ptemp,pdata1,pdata2: PTokenData;
      x,y: PToken;
      h,k: Integer;
      pline1,pline2: PLineRecord;
      i: Integer;
      token: PToken;
      bInserted: Boolean;
      bMatched: Boolean;
      stemp1,stemp2: xString;
      bComment: Boolean;
      i1,i2: Integer;
  begin
    S1 := '';
    S2 := '';
    colorstrips1 := TSortedDLinkedList.create;
    colorstrips2 := TSortedDLinkedList.create;
    bInserted := false;
    bMatched := false;

    diffres := ES_MATCH;

    x := nil; y := nil;
    stemp1 := _getnonWStoken(lexer1,x);
    stemp2 := _getnonWStoken(lexer2,y);
    _putWS(stemp1,stemp2,false);
    while (index1 <= size1) or (index2 <= size2) do begin
      if (index1 and CYCLE_THRESHOLD = 0) or (index2 and CYCLE_THRESHOLD = 0) then begin
        FileDiffForm.SimpleUpdateStatusBar(ch,cd,ci,cm);
        Application.ProcessMessages;
      end;
      if FGlobalHalt then
        break;
      if highlightSet <> nil then begin
        if (index1 > size1) or (not highlightSet.get(ia1[index1].tokentype,Integer(phighlight1))) then
          phighlight1 := pdefhighlight;
        if (index2 > size2) or (not highlightSet.get(ia2[index2].tokentype,Integer(phighlight2))) then
          phighlight2 := pdefhighlight;
      end
      else begin
        phighlight1 := pdefhighlight;
        phighlight2 := pdefhighlight;
      end;

      begin
        //ln1,ln2 <> nil because ia1,ia2 are without nil and index1,index2 <= size1,size2
        if (index1 <= size1) and (index2 <= size2) and (ln1 <> nil) and (PToken(ln1.i) = ia1[index1]) and (PToken(ln2.i) = ia2[index2]) then begin
          if bInserted then begin
            bInserted := false;
          end;

          bMatched := true;

          bComment := (ia1[index1].tokentype = CL) or (ia1[index1].tokentype = C1) or (ia1[index1].tokentype = C2);
          bComment := bComment or (ia2[index2].tokentype = CL) or (ia2[index2].tokentype = C1) or (ia2[index2].tokentype = C2);

          if (ia1[index1].tokentype <= MAX_TERMINAL) and ((ia1[index1].value <> '') or (ia2[index2].value <> '')) then begin
//            if ia1[index1].value <> '' then begin
//              colorStrips1.add(Length(S1)+1,Length(ia1[index1].value),clBlack,clWhite);
              i1 := Length(ia1[index1].value);
              i2 := Length(ia2[index2].value);
              if (i1 = i2) and _case_sense_equal(ia1[index1].value,ia2[index2].value) then begin
//                diffres := ES_MATCH;
                c := COLOR_MATCH;
                cm := cm + 1;
                if not bComment then begin
                  colorStrips1.add(Length(S1)+1,i1,COLOR_MATCH,phighlight1.tc,Integer(phighlight1.style));
                  colorStrips2.add(Length(S2)+1,i2,COLOR_MATCH,phighlight2.tc,Integer(phighlight2.style));
                end
                else begin
                  cstart1 := Length(S1)+1;
                  cstart2 := Length(S2)+1;
                  clen1 := i1;
                  clen2 := i2;
                  tc1 := phighlight1.tc;
                  tc2 := phighlight2.tc;
                  ts1 := Integer(phighlight1.style);
                  ts2 := Integer(phighlight2.style);
                  diffresult := ES_MATCH;
                end;
{                S1 := S1 + ia1[index1].value;
                S2 := S2 + ia2[index2].value;}
              end
              else begin
{                if not bComment then begin
                  if i1 > i2 then begin
                    S := ia2[index2].value + dupestring(' ',i1 - i2);
                  end
                  else if i2 > i1 then begin
                    S := ia1[index1].value + dupestring(' ',i2 - i1);
                  end;
                end;  }
//                colorStrips1.add(Length(S1)+1,max(i1,i2),COLOR_CHANGE,TCOLOR_CHANGE);
//                colorStrips2.add(Length(S2)+1,max(i1,i2),COLOR_CHANGE,TCOLOR_CHANGE);
                if diffres <> ES_COMBINED then begin
                  if diffres = ES_MATCH then
                    diffres := ES_CHANGE
                  else if diffres <> ES_CHANGE then
                    diffres := ES_COMBINED;
                end;
                c := COLOR_CHANGE;
                ch := ch + 1;
                if not bComment then begin
                  colorStrips1.add(Length(S1)+1,max(i1,i2),COLOR_CHANGE,phighlight1.tc,Integer(phighlight1.style));
                  colorStrips2.add(Length(S2)+1,max(i1,i2),COLOR_CHANGE,phighlight2.tc,Integer(phighlight2.style));
                end
                else begin
                  cstart1 := Length(S1)+1;
                  cstart2 := Length(S2)+1;
                  clen1 := i1;//max(i1,i2);
                  clen2 := i2;//max(i1,i2);
                  tc1 := phighlight1.tc;
                  tc2 := phighlight2.tc;
                  ts1 := Integer(phighlight1.style);
                  ts2 := Integer(phighlight2.style);
                  diffresult := ES_CHANGE;
                end;
{
                if (i2 > i1) and (not bComment) then begin
                  S1 := S1 + S
                end
                else begin
                  S1 := S1 + ia1[index1].value
                end;
                if (i1 > i2) and (not bComment) then begin
                  S2 := S2 + S
                end
                else begin
                  S2 := S2 + ia2[index2].value;
                end;
}
              end;

              if (x.tokentype = ia1[index1].tokentype) and _case_equal(x.value,ia1[index1].value) and (y.tokentype = ia2[index2].tokentype) and _case_equal(y.value,ia2[index2].value) then begin
                _addtoStrings(i1,i2,bComment,x.value,y.value);
                stemp1 := _getnonWStoken(lexer1,x);
                stemp2 := _getnonWStoken(lexer2,y);
                _putWS(stemp1,stemp2,bComment);
              end
              else if (ia1[index1].value = '') then begin
                _addtoStrings(i1,i2,bComment,x.value,y.value);
                stemp2 := _getnonWStoken(lexer2,y);
                stemp1 := '';//stemp2;
                _putWS(stemp1,stemp2,bComment);
              end
              else if (ia2[index2].value = '') then begin
                _addtoStrings(i1,i2,bComment,x.value,y.value);
                stemp1 := _getnonWStoken(lexer1,x);
                stemp2 := '';//stemp1;
                _putWS(stemp1,stemp2,bComment);
              end
              else begin
                while (x.tokentype <> L_EOF) and (y.tokentype <> L_EOF) and (not ((x.tokentype = ia1[index1].tokentype) and _case_equal(x.value,ia1[index1].value) and (y.tokentype = ia2[index2].tokentype) and _case_equal(y.value,ia2[index2].value))) do begin
                  if (x.tokentype = ia1[index1].tokentype) and _case_equal(x.value,ia1[index1].value) then
                    stemp2 := _getnonWStoken(lexer2,y)
                  else if (y.tokentype = ia2[index2].tokentype) and _case_equal(y.value,ia2[index2].value) then
                    stemp1 := _getnonWStoken(lexer1,x)
                  else begin
                    stemp1 := _getnonWStoken(lexer1,x);
                    stemp2 := _getnonWStoken(lexer2,y);
                  end;
                end;
                if (x.tokentype = L_EOF) or (y.tokentype = L_EOF) then begin
                  FileDiffForm.StatusBar1.Panels[4].Text := 'Tree/file mismatch error.';
                  break;
                end
                else begin
                  _addtoStrings(i1,i2,bComment,x.value,y.value);
                  stemp1 := _getnonWStoken(lexer1,x);
                  stemp2 := _getnonWStoken(lexer2,y);
                  _putWS(stemp1,stemp2,bComment);
                end;
              end;
          end;

          //move pointers in mapping and preorder arrays
          ln1 := ln1.next;
          if ln1 <> nil then
            ln1 := ln1.next;
          ln2 := ln2.next;
          if ln2 <> nil then
            ln2 := ln2.next;
          index1 := index1 + 1;
          index2 := index2 + 1;
        end
        else if (index1 > size1) or ((ln1 <> nil) and (PToken(ln1.i) = ia1[index1])) then begin
          //add to both the tokens of tree2 (in tree1 as insert / in tree2 as delete)
          if bMatched then begin
//            _managestacks(true,true,true,false,false,false,pdata1,pdata2,indent);
            bMatched := false;
          end
          else begin
          end;

          bInserted := true;

          bComment := (ia2[index2].tokentype = CL) or (ia2[index2].tokentype = C1) or (ia2[index2].tokentype = C2);

          if (ia2[index2].tokentype <= MAX_TERMINAL) and (ia2[index2].value <> '') then begin
              if diffres <> ES_COMBINED then begin
                if diffres = ES_MATCH then
                  diffres := ES_INSERT
                else if diffres <> ES_INSERT then
                  diffres := ES_COMBINED;
              end;
              c := COLOR_INSERT;
              ci := ci + 1;
              if not bComment then begin
                colorStrips1.add(Length(S1)+1,Length(ia2[index2].value),COLOR_INSERT,pdefhighlight.tc,Integer(pdefhighlight.style));
                colorStrips2.add(Length(S2)+1,Length(ia2[index2].value),COLOR_INSERT,phighlight2.tc,Integer(phighlight2.style));
              end
              else begin
                cstart1 := Length(S1)+1;
                cstart2 := Length(S2)+1;
                clen1 := 0;//Length(ia2[index2].value);
                clen2 := Length(ia2[index2].value);
                tc1 := pdefhighlight.tc;
                tc2 := phighlight2.tc;
                ts1 := Integer(pdefhighlight.style);
                ts2 := Integer(phighlight2.style);
                diffresult := ES_INSERT;
              end;
//              colorStrips1.add(Length(S1)+1,Length(ia2[index2].value),COLOR_INSERT,TCOLOR_INSERT);
//              colorStrips2.add(Length(S2)+1,Length(ia2[index2].value),COLOR_INSERT,TCOLOR_INSERT);
{              if not bComment then begin
                S1 := S1 + dupestring(' ',Length(ia2[index2].value));
                S2 := S2 + ia2[index2].value;
              end
              else begin
                S2 := S2 + ia2[index2].value;
              end;}

              if (y.tokentype = ia2[index2].tokentype) and _case_equal(y.value,ia2[index2].value) then begin
                _addtoStrings(0,Length(ia2[index2].value),bComment,'',ia2[index2].value);
                stemp2 := _getnonWStoken(lexer2,y);
                stemp1 := '';//stemp2;
                _putWS(stemp1,stemp2,bComment);
              end
              else begin
                while (y.tokentype <> L_EOF) and (not ((y.tokentype = ia2[index2].tokentype) and _case_equal(y.value,ia2[index2].value))) do begin
                    stemp2 := _getnonWStoken(lexer2,y);
                end;
                if (y.tokentype = L_EOF) then begin
                  FileDiffForm.StatusBar1.Panels[4].Text := 'Tree/file mismatch error.';
                  break;
                end
                else begin
                  _addtoStrings(0,Length(ia2[index2].value),bComment,'',ia2[index2].value);
                  stemp2 := _getnonWStoken(lexer2,y);
                  stemp1 := '';//stemp2;
                  _putWS(stemp1,stemp2,bComment);
                end;
              end;
          end;

          index2 := index2 + 1;
        end
        else if true or (index2 > size2) or (PToken(ln2.i) = ia2[index2]) then begin
          //add to both the tokens of tree1 (in tree2 as insert / in tree1 as delete)
          //OR
          //none of current tokens is in mapping => add to both from tree1, until ia1[index1] = ln1.i
          //OR
          //anyway
          if bMatched then begin
//            _managestacks(true,true,false,true,false,false,pdata1,pdata2,indent);
            bMatched := false;
          end
          else begin
          end;

          bComment := (ia1[index1].tokentype = CL) or (ia1[index1].tokentype = C1) or (ia1[index1].tokentype = C2);

          if (ia1[index1].tokentype <= MAX_TERMINAL) and (ia1[index1].value <> '') then begin
              if diffres <> ES_COMBINED then begin
                if diffres = ES_MATCH then
                  diffres := ES_DELETE
                else if diffres <> ES_DELETE then
                  diffres := ES_COMBINED;
              end;
              c := COLOR_DELETE;
              cd := cd + 1;
              if not bComment then begin
                colorStrips1.add(Length(S1)+1,Length(ia1[index1].value),COLOR_DELETE,phighlight1.tc,Integer(phighlight1.style));
                colorStrips2.add(Length(S2)+1,Length(ia1[index1].value),COLOR_DELETE,pdefhighlight.tc,Integer(pdefhighlight.style));
              end
              else begin
                cstart1 := Length(S1)+1;
                cstart2 := Length(S2)+1;
                clen1 := Length(ia1[index1].value);
                clen2 := 0;//Length(ia1[index1].value);
                tc1 := phighlight1.tc;
                tc2 := pdefhighlight.tc;
                ts1 := Integer(phighlight1.style);
                ts2 := Integer(pdefhighlight.style);
                diffresult := ES_DELETE;
              end;
//              colorStrips1.add(Length(S1)+1,Length(ia1[index1].value),COLOR_DELETE,TCOLOR_DELETE);
//              colorStrips2.add(Length(S2)+1,Length(ia1[index1].value),COLOR_DELETE,TCOLOR_DELETE);
{              if not bComment then begin
                S1 := S1 + ia1[index1].value;
                S2 := S2 + dupestring(' ',Length(ia1[index1].value));
              end
              else begin
                S1 := S1 + ia1[index1].value;
              end;}

              if (x.tokentype = ia1[index1].tokentype) and _case_equal(x.value,ia1[index1].value) then begin
                _addtoStrings(Length(ia1[index1].value),0,bComment,ia1[index1].value,'');
                stemp1 := _getnonWStoken(lexer1,x);
                stemp2 := '';//stemp1;
                _putWS(stemp1,stemp2,bComment);
              end
              else begin
                while (x.tokentype <> L_EOF) and (not ((x.tokentype = ia1[index1].tokentype) and _case_equal(x.value,ia1[index1].value))) do begin
                    stemp1 := _getnonWStoken(lexer1,x);
                end;
                if (x.tokentype = L_EOF) then begin
                  FileDiffForm.StatusBar1.Panels[4].Text := 'Tree/file mismatch error.';
                  break;
                end
                else begin
                  _addtoStrings(Length(ia1[index1].value),0,bComment,ia1[index1].value,'');
                  stemp1 := _getnonWStoken(lexer1,x);
                  stemp2 := '';//stemp1;
                  _putWS(stemp1,stemp2,bComment);
                end;
              end;
          end;

          index1 := index1 + 1;
        end;
      end;
    end;

    if not bInserted then begin
    end
    else begin
    end;

    if (S1 <> '') or (S2 <> '') then begin   //moze sa stat ak za end. uz nic neni
      _addlines(0);
    end;

    if x <> nil then
      dispose(x);
    if y <> nil then
      dispose(y);

    colorstrips1.Free;
    colorstrips2.Free;

    FileDiffForm.StatusBar1.Panels[4].Text := 'Ended.';
  end;

var stopwatch: Integer;
begin
  stopwatch := getcurrenttime;
  FileDiffForm.StatusBar1.Panels[4].Text := 'Coloring...';
  ch := 0; cd := 0; ci := 0; cm := 0;

  new(result);
  lineno := 0;
  bNewLine := false;

  ln1 := nil;
  ln2 := nil;
  if L <> nil then begin
    ln1 := L.head;
    if ln1 <> nil then
      ln2 := ln1.next;
  end;

  Lines1 := TStringList.create;
  Lines2 := TStringList.create;

  reader1 := TSimpleStringReader.create;
  b := reader1.open(LForm.FLoadedPath,LForm.RichEdit1.Text);
  reader2 := TSimpleStringReader.create;
  b := reader2.open(RForm.FLoadedPath,RForm.RichEdit1.Text);

  if GrammarEditForm.FDFA = nil then begin
    lexer1 := TLexer.create(reader1,GrammarEditForm.FGFL.getNFA,nil);
    lexer2 := TLexer.create(reader2,GrammarEditForm.FGFL.getNFA,nil);
  end
  else begin
    lexer1 := TLexer.create(reader1,nil,GrammarEditForm.FDFA);
    lexer2 := TLexer.create(reader2,nil,GrammarEditForm.FDFA);
  end;
  lexer1.setCaseSensitivity(true);
  lexer2.setCaseSensitivity(true);

  fillPreOrderArrays(root1,size1,root2,size2);  //1 based!!!, root should NOT have any siblings
  if root1 <> nil then
    root1._parent := nil;
  if root2 <> nil then
    root2._parent := nil;

  QT := TQueueStack.create;
  QT2 := TQueueStack.create;

  index1 := 1;
  index2 := 1;

  _init;
  _walk;

  QT.Free;
  QT2.Free;

  lexer1.Free;
  lexer2.Free;

  reader1.Free;
  reader2.Free;

  stopwatch := getcurrenttime - stopwatch;

{$IFDEF DEBUG0}
  writeln('Coloring time: ' + IntToStr(stopwatch) + ' ms');
{$ENDIF}
{$IFDEF LOG0}
  LogForm.AddLine('Coloring time: ' + IntToStr(stopwatch) + ' ms');
{$ENDIF}

  result.nc := ch;
  result.nd := cd;
  result.ni := ci;
  result.nm := cm;
//  if S <> '' then
//    result.add(S);
end;

/// funkcia vypisujuca vstupne stromy a vyznacujuca rozdiely medzi nimi, s vyznacovanim syntaxe
/// sucasne pouzivajuca formatovanie definovane v subore so vstupnou gramatikou,
/// vstupy su nasledovne:
/// root1 je koren vstupneho stromu s velkostou size1;
/// root2 je koren vstupneho stromu s velkostou size2;
/// L je vstupne mapovanie vrcholov oboch stromov;
/// LRuleTable je tabulka pravidiel, ktora vsak obsahuje aj mnoziny mnozin tokenov definujuce skore pre zhodne,ekvivalentne a podobne tokeny;
/// IndentSet je mnozina mnozin definujuca formatovanie textu nepouzivana v tejto funkcii;
/// HighlightSet je mnozina mnozin definujuca vyznacovanie syntaxe;
/// Lines1,Lines2 su vystupne zoznamy stringov s definovanymi farebnymi odlisnostami, pridanymi volnymi riadkami a synchronizovanymi vypismi;
/// indent je pociatocne odsadenie;
/// bBkColor je boolean definujuci, ci pri syntax highlightingu sa vyuziva aj farba pozadia pre text, tak ako definovany v gramatiky, vacsinou
/// ak sa stromy aj porovnavaju, tak je tento boolean nastaveny na false aby zobrazovanie rozdielov nebolo prilis neprehladne;
/// bWantResult je boolean urcujuci, ci chceme vytvorit record s vysledkami porovnavanie, ak je nastaveny na false, tak ako
/// vysledok sa vrati hodnota nil
/// vystupom je vysledok porovnavania aj s konkretnym poctom vlozeni,vymazani,modifikacii tokenov (alebo nil, ak je predosly boolean = false)
function ParallelPreOrder(root1: PToken; size1: Integer; root2: PToken; size2: Integer; L: PIntList; LRuleTable: TRuleTable; IndentSet,HighlightSet: TIntIntHashSet; var Lines1,Lines2: TStringList; indent: Integer = 0; bBkColor: Boolean = true; bWantResult: Boolean = false): PTreeCompareResult;
var bNewLine: Boolean;
    lineno: Integer;
    S1,S2,S: xString;
    ln1,ln2: PIntNode;
    curr1,curr2: PToken;
    QT,QT2,Q1,Q2,Qtemp: TQueueStack;
    index1,index2: Integer;
    colorstrips1,colorstrips2: TSortedDLinkedList;
    pdef1,pdef2: PTokenData;
    pdefhighlight: PTokenHighlight;
    diffres,diffresult: Integer;
    c: TColor;
    ch,cd,ci,cm: Integer;
    CL,C1,C2: Integer;
    phighlight1,phighlight2: PTokenHighlight;
    cstart1,cstart2,clen1,clen2: Integer;
    tc1,tc2: TColor;
    ts1,ts2: Integer;
    treeresult: Integer;

  procedure _init;
  var b1,b2: Boolean;
  begin
    b1 := false; b2 := false;
    if indentSet <> nil then begin
      b1 := indentSet.get(0,Integer(pdef1));
      b2 := indentSet.get(0,Integer(pdef2));
    end;
    if (indentSet = nil) or (not b1) then begin
      new(pdef1);
      pdef1.bspace := 0;
      pdef1.bindent := 0;
      pdef1.beoln := 0;
      pdef1.bexcept := nil;
      pdef1.aspace := 1;
      pdef1.aindent := 0;
      pdef1.aeoln := 0;
      pdef1.aexcept := nil;
    end;
    if (indentSet = nil) or (not b2) then begin
      new(pdef2);
      pdef2.bspace := 0;
      pdef2.bindent := 0;
      pdef2.beoln := 0;
      pdef2.bexcept := nil;
      pdef2.aspace := 1;
      pdef2.aindent := 0;
      pdef2.aeoln := 0;
      pdef2.aexcept := nil;
    end;
    if highlightSet <> nil then begin
      b1 := highlightSet.get(0,Integer(pdefhighlight));
    end;
    if (highlightSet = nil) or (not b1) then begin
      new(pdefhighlight);
      pdefhighlight.tc := TCOLOR_DEFAULT;
      pdefhighlight.bc := COLOR_TEXTBACKGROUND;
      pdefhighlight.style := 0;
    end;
    if LRuleTable <> nil then
      LRuleTable.getComments(CL,C1,C2)
    else begin
      CL := -1;
      C1 := -1;
      C2 := -1;
    end;
  end;

  procedure _addlines(ind: Integer);
  var pline1,pline2: PLineRecord;
      Stemp: xString;
  begin
    Application.ProcessMessages;
    if FGlobalHalt then
      Exit;
    Stemp := dupestring(' ',ind);
    if not bBkColor then begin
      diffres := ES_NOT_COMPARED;
(*      colorStrips1.Free;
      colorStrips2.Free;
      colorStrips1 := nil;
      colorStrips2 := nil;*)
    end;
    new(pline1);
    pline1.diffres := diffres;
    pline1.colorStrips := colorStrips1;
    Lines1.AddObject(S1,TObject(pline1));
    new(pline2);
    pline2.diffres := diffres;
    pline2.colorStrips := colorStrips2;
    Lines2.AddObject(S2,TObject(pline2));
    S1 := Stemp;
    S2 := Stemp;
    colorStrips1 := TSortedDLinkedList.create;
    colorStrips2 := TSortedDLinkedList.create;
    diffres := ES_MATCH;
  end;

  procedure _replaceTabs(var str: xString; from: Integer = 1);
  var i: Integer;
  begin
    clearGCA;
    for i := 1 to Length(str) do begin
      if i >= from then begin
        if str[i] = SET_TABCHAR then
          addStringtoGCA(dupestring(' ',TAB_SPACES))
        else if str[i] = SET_EOLWS then
          addtoGCA(SET_EOLWS)
        else if str[i] <> SET_EOLFILLER then
          addtoGCA(str[i]);
      end
      else begin
        addtoGCA(str[i]);
      end;
    end;
    toStringGCA(str);
  end;

  procedure _correctComments(str1,str2: xString);
  var i,j: Integer;
      string1,string2: xString;
      Stemp: xString;
      i1,i2: Integer;
      key1,key2: Integer;
      cend1,cend2: Integer;
      bNewLine,bMultiLine: Boolean;
      ind: Integer;
  begin
    cstart1 := Length(S1) + 1;
    cstart2 := Length(S2) + 1;
    _replaceTabs(str1,1);//cstart1);
    _replaceTabs(str2,1);//cstart2);
    i1 := 0; i2 := 0;
    bNewLine := false;
    bMultiLine := false;
    key1 := cstart1;//Length(S1)+1;
    key2 := cstart2;//Length(S2)+1;
    string1 := S1;
    string2 := S2;
    clen1 := Length(str1);
    clen2 := Length(str2);
    cend1 := clen1;//cstart1 + clen1 - 1;
    cend2 := clen2;//cstart2 + clen2 - 1;
    i := 1;//cstart1;
    j := 1;//cstart2;

    if MULTI_LINE_COMMENTS_IND then begin
      ind := indent;
    end
    else begin
      ind := 0;
    end;

    while (i <= cend1) or (j <= cend2) do begin
      if (i and CYCLE_THRESHOLD = 0) or (j and CYCLE_THRESHOLD = 0) then begin
        Application.ProcessMessages;
      end;
      if FGlobalHalt then
        break;
      if (i <= cend1) and (j <= cend2) then begin
        if (str1[i] = str2[j]) then begin
          if (str1[i] = SET_EOLWS) then begin
            S1 := string1;
            S2 := string2;
            colorStrips1.add(key1,i1,c,tc1,ts1);//phighlight1.tc,Integer(phighlight1.style));
            colorStrips2.add(key2,i2,c,tc2,ts2);//phighlight2.tc,Integer(phighlight2.style));
            _addlines(ind);
            diffres := diffresult;
            key1 := Length(S1) + 1;
            key2 := Length(S2) + 1;
            string1 := S1;
            string2 := S2;
            bNewLine := true;
            bMultiLine := true;
            i := i + 1;
            j := j + 1;
            i1 := 0;
            i2 := 0;
          end
          else begin
            string1 := string1 + str1[i];
            string2 := string2 + str2[j];
            i := i + 1;
            j := j + 1;
            i1 := i1 + 1;
            i2 := i2 + 1;
            bNewLine := false;
          end;
        end
        else begin
          if (str1[i] <> SET_EOLWS) and (str2[j] <> SET_EOLWS) then begin
            string1 := string1 + str1[i];
            string2 := string2 + str2[j];
            i := i + 1;
            j := j + 1;
            i1 := i1 + 1;
            i2 := i2 + 1;
            bNewLine := false;
          end
          else if (str2[j] <> SET_EOLWS) then begin
            string1 := string1 + ' ';
            string2 := string2 + str2[j];
            j := j + 1;
            i1 := i1 + 1;
            i2 := i2 + 1;
            bNewLine := false;
          end
          else begin
            string1 := string1 + str1[i];
            string2 := string2 + ' ';
            i := i + 1;
            i1 := i1 + 1;
            i2 := i2 + 1;
            bNewLine := false;
          end;
        end;
      end
      else if (i <= cend1) then begin
          if (str1[i] = SET_EOLWS) then begin
            S1 := string1;
            S2 := string2;
            colorStrips1.add(key1,i1,c,tc1,ts1);//phighlight1.tc,Integer(phighlight1.style));
            colorStrips2.add(key2,i2,c,tc2,ts2);//phighlight2.tc,Integer(phighlight2.style));
            _addlines(ind);
            diffres := diffresult;
            key1 := Length(S1) + 1;
            key2 := Length(S2) + 1;
            string1 := S1;
            string2 := S2;
            bNewLine := true;
            bMultiLine := true;
            i := i + 1;
//            j := j + 1;
            i1 := 0;
            i2 := 0;
          end
          else begin
            string1 := string1 + str1[i];
            string2 := string2 + ' ';
            i := i + 1;
            i1 := i1 + 1;
            i2 := i2 + 1;
            bNewLine := false;
          end;
      end
      else begin
          if (str2[j] = SET_EOLWS) then begin
            S1 := string1;
            S2 := string2;
            colorStrips1.add(key1,i1,c,tc1,ts1);//phighlight1.tc,Integer(phighlight1.style));
            colorStrips2.add(key2,i2,c,tc2,ts2);//phighlight2.tc,Integer(phighlight2.style));
            _addlines(ind);
            diffres := diffresult;
            key1 := Length(S1) + 1;
            key2 := Length(S2) + 1;
            string1 := S1;
            string2 := S2;
            bNewLine := true;
            bMultiLine := true;
//            i := i + 1;
            j := j + 1;
            i1 := 0;
            i2 := 0;
          end
          else begin
            string1 := string1 + ' ';
            string2 := string2 + str2[j];
            j := j + 1;
            i1 := i1 + 1;
            i2 := i2 + 1;
            bNewLine := false;
          end;
      end;
    end;

    if (i1 > 0) or (i2 > 0) then begin
      colorStrips1.add(key1,i1,c,tc1,ts1);//phighlight1.tc,Integer(phighlight1.style));
      colorStrips2.add(key2,i2,c,tc2,ts2);//phighlight2.tc,Integer(phighlight2.style));
    end;
    if bNewLine then begin
      diffres := ES_MATCH;
    end;
    if not MULTI_LINE_COMMENTS_IND then begin
      if bMultiLine then begin
         if bNewLine then begin

(*            token := PToken(QT.pop);
            ptemp := PTokenData(QT.pop);
            //apply after section of PTokenData
            if isFirst then begin //and ((ptemp.aexcept = nil) or (ia1[index1]._parent = nil) or (ptemp.aexcept.contains(ia1[index1]._parent.tokentype))) then begin
              if ptemp.aindent < 0 then begin
                if S1 = dupestring(' ',ind) then
                  S1 := dupestring(' ',ind+ptemp.aindent);
                if S2 = dupestring(' ',ind) then
                  S2 := dupestring(' ',ind+ptemp.aindent);
              end;
              ind := ind + ptemp.aindent;
              if token.tokentype <= MAX_TERMINAL then begin  //terminal spaces
                S1 := S1 + dupestring(' ',ptemp.aspace);
                S2 := S2 + dupestring(' ',ptemp.aspace);
              end;
              for i := 1 to ptemp.aeoln do begin
                _addlines(ind);
              end;
            end;*)

           S1 := dupestring(' ',indent) + string1;
           S2 := dupestring(' ',indent) + string2;
           Exit;
         end
         else begin
           S1 := dupestring(' ',indent) + string1;
           S2 := dupestring(' ',indent) + string2;
           Exit;
         end;
      end;
    end;
    S1 := string1;
    S2 := string2;
  end;

  procedure _managestacks(enableFirst,enableSecond,isFirst,isSecond: Boolean; bFirst,bSecond: Boolean; var pdata1,pdata2: PTokenData; var ind: Integer; bOne: Boolean);
  var ptemp: PTokenData;
      w: PToken;
      h,k: Integer;
      i: Integer;
      token: PToken;
      Stemp: xString;
      treec,treetc,trees: Integer;
  begin
    diffresult := diffres;
//    if T <> nil then begin
      if enableFirst then begin
        if not QT.isEmpty then begin
          token := PToken(QT.top);
          while (not QT.isEmpty) and ((index1 > size1) or (ia1[index1]._inorder <= token._inorder)) do begin
            token := PToken(QT.pop);
            ptemp := PTokenData(QT.pop);
            //apply after section of PTokenData
            if isFirst then begin //and ((ptemp.aexcept = nil) or (ia1[index1]._parent = nil) or (ptemp.aexcept.contains(ia1[index1]._parent.tokentype))) then begin
              if ptemp.aindent <> 0 then begin
                if S1 = dupestring(' ',ind) then
                  S1 := dupestring(' ',ind+ptemp.aindent);
                if S2 = dupestring(' ',ind) then
                  S2 := dupestring(' ',ind+ptemp.aindent);
              end;
              ind := ind + ptemp.aindent;
              if (Length(S1) > indent) or (NEW_LINE_PREV_LINE_TOKEN_ASPACES) then begin
                if token.tokentype <= MAX_TERMINAL then begin  //terminal spaces
                  S1 := S1 + dupestring(' ',ptemp.aspace);
                  S2 := S2 + dupestring(' ',ptemp.aspace);
                end;
              end;
              for i := 1 to ptemp.aeoln do begin
                _addlines(ind);
              end;
            end;
            if bOne then
              break;
            token := PToken(QT.top);
          end;
        end;
        if bFirst and (index1 <= size1) then begin
          if (pdata1.aexcept <> nil) and (pdata1.aexcept.contains(ia1[index1]._parent.tokentype)) then
            QT.push(Integer(pdef1))
          else
            QT.push(Integer(pdata1));
          if (pdata1.bexcept <> nil) and (pdata1.bexcept.contains(ia1[index1]._parent.tokentype)) then
            pdata1 := pdef1;

          QT.push(Integer(ia1[index1]));
          //apply before section of PTokenData
          if isFirst then begin
            if pdata1.bindent <> 0 then begin
              if S1 = dupestring(' ',ind) then
                S1 := dupestring(' ',ind+pdata1.bindent);
              if S2 = dupestring(' ',ind) then
                S2 := dupestring(' ',ind+pdata1.bindent);
            end;
            ind := ind + pdata1.bindent;
            if ia1[index1].tokentype <= MAX_TERMINAL then begin  //terminal spaces
              S1 := S1 + dupestring(' ',pdata1.bspace);
              S2 := S2 + dupestring(' ',pdata1.bspace);
            end;
            for i := 1 to pdata1.beoln do begin
              _addlines(ind);
            end;
          end;
//          if S1 = dupestring(' ', ind) then begin
              if ((ia1[index1].tokentype > MAX_TERMINAL) and (TREE_FORMATTING)) then begin
//               if Length(S1) = indent then begin

                if (GrammarEditForm <> nil) and (GrammarEditForm.FParser <> nil) and (GrammarEditForm.FParser.LStateNameTypeTable <> nil) then
                  if GrammarEditForm.FParser.LStateNameTypeTable.getByValue(ia1[index1].tokentype,Stemp,i) then begin
                    if bBkColor then begin
                      if treeresult = ES_INSERT then begin
                        treec := COLOR_INSERT;
                        treetc := TCOLOR_INSERT;
                        trees := 0;
                      end
                      else if treeresult = ES_DELETE then begin
                        treec := COLOR_DELETE;
                        treetc := TCOLOR_DELETE;
                        trees := 0;
                      end
                      else begin  //ES_MATCH
                        treec := COLOR_MATCH;
                        treetc := TCOLOR_MATCH;
                        trees := 0;
                      end;
                    end
                    else begin
                      treec := COLOR_NOT_COMPARED;
                      treetc := TCOLOR_NOT_COMPARED;
                      trees := 0;
                    end;
                    colorStrips1.add(Length(S1)+1,Length(Stemp)+2,treec,treetc,trees);
                    colorStrips2.add(Length(S2)+1,Length(Stemp)+2,treec,treetc,trees);
                    if treeresult = ES_INSERT then
                      S1 := S1 + '<' + dupestring(' ',Length(Stemp)) + '>'
                    else
                      S1 := S1 + '<' + Stemp + '>';
                    if treeresult = ES_DELETE then
                      S2 := S2 + '<' + dupestring(' ',Length(Stemp)) + '>'
                    else
                      S2 := S2 + '<' + Stemp + '>';
                  end;
//                end;
              end;
//          end;
        end;
      end;
      if enableSecond then begin
        if not QT2.isEmpty then begin
          token := PToken(QT2.top);
          while (not QT2.isEmpty) and ((index2 > size2) or (ia2[index2]._inorder <= token._inorder)) do begin
            token := PToken(QT2.pop);
            ptemp := PTokenData(QT2.pop);
            //apply after section of PTokenData
            if isSecond then begin
              if ptemp.aindent <> 0 then begin
                if S1 = dupestring(' ',ind) then begin
                  if S1 = dupestring(' ',ind) then
                    S1 := dupestring(' ',ind+ptemp.aindent);
                  if S2 = dupestring(' ',ind) then
                    S2 := dupestring(' ',ind+ptemp.aindent);
                end;
              end;
              ind := ind + ptemp.aindent;
              if (Length(S1) > indent) or (NEW_LINE_PREV_LINE_TOKEN_ASPACES) then begin
                if token.tokentype <= MAX_TERMINAL then begin  //terminal spaces
                  S1 := S1 + dupestring(' ',ptemp.aspace);
                  S2 := S2 + dupestring(' ',ptemp.aspace);
                end;
              end;
              for i := 1 to ptemp.aeoln do begin
                _addlines(ind);
              end;
            end;
            if bOne then
              break;
            token := PToken(QT2.top);
          end;
        end;
        if bSecond and (index2 <= size2) then begin
          if (pdata2.aexcept <> nil) and (pdata2.aexcept.contains(ia2[index2]._parent.tokentype)) then
            QT2.push(Integer(pdef2))
          else
            QT2.push(Integer(pdata2));
          if (pdata2.bexcept <> nil) and (pdata2.bexcept.contains(ia2[index2]._parent.tokentype)) then
            pdata2 := pdef2;

          QT2.push(Integer(ia2[index2]));
          //apply before section of PTokenData
          if isSecond then begin
            if pdata2.bindent <> 0 then begin
              if S1 = dupestring(' ',ind) then
                S1 := dupestring(' ',ind+pdata2.bindent);
              if S2 = dupestring(' ',ind) then
                S2 := dupestring(' ',ind+pdata2.bindent);
            end;
            ind := ind + pdata2.bindent;
            if ia2[index2].tokentype <= MAX_TERMINAL then begin  //terminal spaces
              S1 := S1 + dupestring(' ',pdata2.bspace);
              S2 := S2 + dupestring(' ',pdata2.bspace);
            end;
            for i := 1 to pdata2.beoln do begin
              _addlines(ind);
            end;
          end;
//          if S1 = dupestring(' ', ind) then begin
              if ((ia2[index2].tokentype > MAX_TERMINAL) and (TREE_FORMATTING)) then begin
//               if Length(S1) = indent then begin
                if (GrammarEditForm <> nil) and (GrammarEditForm.FParser <> nil) and (GrammarEditForm.FParser.LStateNameTypeTable <> nil) then
                  if GrammarEditForm.FParser.LStateNameTypeTable.getByValue(ia2[index2].tokentype,Stemp,i) then begin
                    if bBkColor then begin
                      if treeresult = ES_INSERT then begin
                        treec := COLOR_INSERT;
                        treetc := TCOLOR_INSERT;
                        trees := 0;
                      end
                      else if treeresult = ES_DELETE then begin
                        treec := COLOR_DELETE;
                        treetc := TCOLOR_DELETE;
                        trees := 0;
                      end
                      else begin  //ES_MATCH
                        treec := COLOR_MATCH;
                        treetc := TCOLOR_MATCH;
                        trees := 0;
                      end;
                    end
                    else begin
                      treec := COLOR_NOT_COMPARED;
                      treetc := TCOLOR_NOT_COMPARED;
                      trees := 0;
                    end;
                    colorStrips1.add(Length(S1)+1,Length(Stemp)+2,treec,treetc,trees);
                    colorStrips2.add(Length(S2)+1,Length(Stemp)+2,treec,treetc,trees);
                    if treeresult = ES_INSERT then
                      S1 := S1 + '<' + dupestring(' ',Length(Stemp)) + '>'
                    else
                      S1 := S1 + '<' + Stemp + '>';
                    if treeresult = ES_DELETE then
                      S2 := S2 + '<' + dupestring(' ',Length(Stemp)) + '>'
                    else
                      S2 := S2 + '<' + Stemp + '>';
                  end;
//                end;
              end;
//          end;
        end;
      end;
//    end;
  end;

  function _case_sense_equal(s1,s2: xString): Boolean;
  begin
    if not LRuleTable.getCaseSensitivity then begin
      s1 := AnsiLowerCase(s1);
      s2 := AnsiLowerCase(s2);
    end;
    result := (s1 = s2);
  end;

  procedure _pre;
  var i1,i2: Integer;
      k1,k2: Integer;
      ptemp,pdata1,pdata2: PTokenData;
      w: PToken;
      h,k: Integer;
      pline1,pline2: PLineRecord;
      i: Integer;
      token: PToken;
      bInserted: Boolean;
      bMatched: Boolean;
      bComment: Boolean;
  begin
    S := dupestring(' ',indent);
    S1 := S;
    S2 := S;
    colorstrips1 := TSortedDLinkedList.create;
    colorstrips2 := TSortedDLinkedList.create;
    bInserted := false;
    bMatched := false;

    if TREE_FORMATTING then begin
      new(pdata1);
      pdata1.bspace := 0;
      pdata1.bindent := 2;
      pdata1.beoln := 1;
      pdata1.bexcept := nil;
      pdata1.aspace := 0;
      pdata1.aindent := -2;
      pdata1.aeoln := 0;
      pdata1.aexcept := nil;

      new(pdata2);
      pdata2.bspace := 0;
      pdata2.bindent := 2;
      pdata2.beoln := 1;
      pdata2.bexcept := nil;
      pdata2.aspace := 0;
      pdata2.aindent := -2;
      pdata2.aeoln := 0;
      pdata2.aexcept := nil;
    end;

    while (index1 <= size1) or (index2 <= size2) do begin
      if (index1 and CYCLE_THRESHOLD = 0) or (index2 and CYCLE_THRESHOLD = 0) then begin
        FileDiffForm.SimpleUpdateStatusBar(ch,cd,ci,cm);
        Application.ProcessMessages;
      end;
      if FGlobalHalt then
        break;
      if (not TREE_FORMATTING) then begin
        if indentSet <> nil then begin
          if (index1 > size1) or (not indentSet.get(ia1[index1].tokentype,Integer(pdata1))) then begin
            pdata1 := pdef1;
          end;
          if (index2 > size2) or (not indentSet.get(ia2[index2].tokentype,Integer(pdata2))) then begin
            pdata2 := pdef2;
          end;
        end
        else begin
          pdata1 := pdef1;
          pdata2 := pdef2;
          if Length(S1) > DEFAULT_LINECHAR_LIMIT_IN_NO_INPUT_MODE then begin
            _addlines(indent);
          end;
        end;
      end;
      if highlightSet <> nil then begin
        if (index1 > size1) or (not highlightSet.get(ia1[index1].tokentype,Integer(phighlight1))) then
          phighlight1 := pdefhighlight;
        if (index2 > size2) or (not highlightSet.get(ia2[index2].tokentype,Integer(phighlight2))) then
          phighlight2 := pdefhighlight;
      end
      else begin
        phighlight1 := pdefhighlight;
        phighlight2 := pdefhighlight;
      end;

      begin
        //ln1,ln2 <> nil because ia1,ia2 are without nil and index1,index2 <= size1,size2
        if (index1 <= size1) and (index2 <= size2) and (ln1 <> nil) and (PToken(ln1.i) = ia1[index1]) and (PToken(ln2.i) = ia2[index2]) then begin
          treeresult := ES_MATCH;
          bComment := (ia1[index1].tokentype = CL) or (ia1[index1].tokentype = C1) or (ia1[index1].tokentype = C2);
          bComment := bComment or (ia2[index2].tokentype = CL) or (ia2[index2].tokentype = C1) or (ia2[index2].tokentype = C2);
          if bInserted then begin
            _managestacks(false,true,false,true,false,false,pdata1,pdata2,indent,true);
            bInserted := false;
          end;
//          _managestacks(true,true,true,false,true,true,pdata1,pdata2,indent);
          _managestacks(true,false,true,false,true,false,pdata1,pdata2,indent,false);

          bMatched := true;

          if (ia1[index1].tokentype <= MAX_TERMINAL) then begin
//            if ia1[index1].value <> '' then begin
//              colorStrips1.add(Length(S1)+1,Length(ia1[index1].value),clBlack,clWhite);
              i1 := Length(ia1[index1].value);
              i2 := Length(ia2[index2].value);
              if (i1 = i2) and _case_sense_equal(ia1[index1].value,ia2[index2].value) then begin
//                diffres := ES_MATCH;
                cm := cm + 1;
                if bBkColor then
                  c := COLOR_MATCH
                else begin
                  if FFormattingWithBkColor then
                    c := phighlight1.bc
                  else
                    c := COLOR_NOT_COMPARED;
                end;
                diffresult := ES_MATCH;
                if not bComment then begin
                  colorStrips1.add(Length(S1)+1,i1,c,phighlight1.tc,Integer(phighlight1.style));
                  colorStrips2.add(Length(S2)+1,i2,c,phighlight2.tc,Integer(phighlight2.style));
                  S1 := S1 + ia1[index1].value;
                  S2 := S2 + ia2[index2].value;
                end
                else begin
                  tc1 := phighlight1.tc;
                  tc2 := phighlight2.tc;
                  ts1 := Integer(phighlight1.style);
                  ts2 := Integer(phighlight2.style);
                  _correctComments(ia1[index1].value,ia2[index2].value);
                end;
              end
              else begin
                if not bComment then begin
                  if i1 > i2 then begin
                    S := ia2[index2].value + dupestring(' ',i1 - i2);
                  end
                  else if i2 > i1 then begin
                    S := ia1[index1].value + dupestring(' ',i2 - i1);
                  end;
                end;
//                colorStrips1.add(Length(S1)+1,max(i1,i2),COLOR_CHANGE,TCOLOR_CHANGE);
//                colorStrips2.add(Length(S2)+1,max(i1,i2),COLOR_CHANGE,TCOLOR_CHANGE);
                ch := ch + 1;
                if diffres <> ES_COMBINED then begin
                  if diffres = ES_MATCH then
                    diffres := ES_CHANGE
                  else if diffres <> ES_CHANGE then
                    diffres := ES_COMBINED;
                end;
                diffresult := ES_CHANGE;
                if bBkColor then
                  c := COLOR_CHANGE
                else begin
                  if FFormattingWithBkColor then
                    c := phighlight1.bc
                  else
                    c := COLOR_NOT_COMPARED;
                end;
                if not bComment then begin
                  colorStrips1.add(Length(S1)+1,max(i1,i2),c,phighlight1.tc,Integer(phighlight1.style));
                  colorStrips2.add(Length(S2)+1,max(i1,i2),c,phighlight2.tc,Integer(phighlight2.style));
                  if i2 > i1 then begin
                    S1 := S1 + S
                  end
                  else begin
                    S1 := S1 + ia1[index1].value
                  end;
                  if i1 > i2 then begin
                    S2 := S2 + S
                  end
                  else begin
                    S2 := S2 + ia2[index2].value;
                  end;
                end
                else begin
                  tc1 := phighlight1.tc;
                  tc2 := phighlight2.tc;
                  ts1 := Integer(phighlight1.style);
                  ts2 := Integer(phighlight2.style);
                  _correctComments(ia1[index1].value,ia2[index2].value);
                end;
              end;
          end;

          //move pointers in mapping and preorder arrays
          ln1 := ln1.next;
          if ln1 <> nil then
            ln1 := ln1.next;
          ln2 := ln2.next;
          if ln2 <> nil then
            ln2 := ln2.next;
          index1 := index1 + 1;
          index2 := index2 + 1;
        end
        else if (index1 > size1) or ((ln1 <> nil) and (PToken(ln1.i) = ia1[index1])) then begin
          //add to both the tokens of tree2 (in tree1 as insert / in tree2 as delete)
          treeresult := ES_INSERT;
          bComment := (ia2[index2].tokentype = CL) or (ia2[index2].tokentype = C1) or (ia2[index2].tokentype = C2);
          if bMatched then begin
//            _managestacks(true,true,true,false,false,false,pdata1,pdata2,indent);
            _managestacks(true,true,true,true,false,false,pdata1,pdata2,indent,true);
            bMatched := false;
          end
          else begin
//            _managestacks(true,false,true,false,false,false,pdata1,pdata2,indent,true);
          end;

          _managestacks(false,true,false,true,false,true,pdata1,pdata2,indent,false);

          bInserted := true;

          if (ia2[index2].tokentype <= MAX_TERMINAL) then begin
              ci := ci + 1;
              if diffres <> ES_COMBINED then begin
                if diffres = ES_MATCH then
                  diffres := ES_INSERT
                else if diffres <> ES_INSERT then
                  diffres := ES_COMBINED;
              end;
              if bBkColor then
                c := COLOR_INSERT
              else begin
                if FFormattingWithBkColor then
                  c := phighlight2.bc
                else
                  c := COLOR_NOT_COMPARED;
              end;
              diffresult := ES_INSERT;
              if not bComment then begin
                colorStrips1.add(Length(S1)+1,Length(ia2[index2].value),c,pdefhighlight.tc,Integer(pdefhighlight.style));
                colorStrips2.add(Length(S2)+1,Length(ia2[index2].value),c,phighlight2.tc,Integer(phighlight2.style));
  //              colorStrips1.add(Length(S1)+1,Length(ia2[index2].value),COLOR_INSERT,TCOLOR_INSERT);
  //              colorStrips2.add(Length(S2)+1,Length(ia2[index2].value),COLOR_INSERT,TCOLOR_INSERT);
                S1 := S1 + dupestring(' ',Length(ia2[index2].value));
                S2 := S2 + ia2[index2].value;
              end
              else begin
                tc1 := pdefhighlight.tc;
                tc2 := phighlight2.tc;
                ts1 := Integer(pdefhighlight.style);
                ts2 := Integer(phighlight2.style);
                _correctComments('',ia2[index2].value);
              end;
          end;

          index2 := index2 + 1;
        end
        else if true or (index2 > size2) or (PToken(ln2.i) = ia2[index2]) then begin
          //add to both the tokens of tree1 (in tree2 as insert / in tree1 as delete)
          //OR
          //none of current tokens is in mapping => add to both from tree1, until ia1[index1] = ln1.i
          //OR
          //anyway
          treeresult := ES_DELETE;
          bComment := (ia1[index1].tokentype = CL) or (ia1[index1].tokentype = C1) or (ia1[index1].tokentype = C2);
          if bMatched then begin
//            _managestacks(true,true,false,true,false,false,pdata1,pdata2,indent);
            _managestacks(true,true,true,true,false,false,pdata1,pdata2,indent,true);
            bMatched := false;
          end
          else begin
//            _managestacks(false,true,false,true,false,false,pdata1,pdata2,indent,true);
          end;

          _managestacks(true,false,true,false,true,false,pdata1,pdata2,indent,false);

          if (ia1[index1].tokentype <= MAX_TERMINAL) then begin
              cd := cd + 1;
              if diffres <> ES_COMBINED then begin
                if diffres = ES_MATCH then
                  diffres := ES_DELETE
                else if diffres <> ES_DELETE then
                  diffres := ES_COMBINED;
              end;
              if bBkColor then
                c := COLOR_DELETE
              else begin
                if FFormattingWithBkColor then
                  c := phighlight1.bc
                else
                  c := COLOR_NOT_COMPARED;
              end;
              diffresult := ES_DELETE;
              if not bComment then begin
                colorStrips1.add(Length(S1)+1,Length(ia1[index1].value),c,phighlight1.tc,Integer(phighlight1.style));
                colorStrips2.add(Length(S2)+1,Length(ia1[index1].value),c,pdefhighlight.tc,Integer(pdefhighlight.style));
  //              colorStrips1.add(Length(S1)+1,Length(ia1[index1].value),COLOR_DELETE,TCOLOR_DELETE);
  //              colorStrips2.add(Length(S2)+1,Length(ia1[index1].value),COLOR_DELETE,TCOLOR_DELETE);
                S1 := S1 + ia1[index1].value;
                S2 := S2 + dupestring(' ',Length(ia1[index1].value));
              end
              else begin
                tc1 := phighlight1.tc;
                tc2 := pdefhighlight.tc;
                ts1 := Integer(phighlight1.style);
                ts2 := Integer(pdefhighlight.style);
                _correctComments(ia1[index1].value,'');
              end;
          end;

          index1 := index1 + 1;
        end;
      end;
    end;

    if not bInserted then begin
      _managestacks(true,true,true,true,false,false,pdef1,pdef2,indent,false);
    end
    else begin
      _managestacks(false,true,false,true,false,false,pdef1,pdef2,indent,true);
      _managestacks(true,true,true,true,false,false,pdef1,pdef2,indent,false);
    end;

    if (S1 <> '') or (S2 <> '') then begin
      _addlines(indent);
    end;

    colorstrips1.Free;
    colorstrips2.Free;

    if TREE_FORMATTING then begin
      dispose(pdata1);
      dispose(pdata2);
    end;
(*
      if not bInserted then begin
        if not QT.isEmpty then begin
          token := PToken(QT.top);
          while (not QT.isEmpty) do begin
            token := PToken(QT.pop);
            ptemp := PTokenData(QT.pop);
            //apply after section of PTokenData
            if ptemp.aindent < 0 then begin
              if S1 = dupestring(' ',indent) then
                S1 := dupestring(' ',indent+ptemp.aindent);
              if S2 = dupestring(' ',indent) then
                S2 := dupestring(' ',indent+ptemp.aindent);
            end;
            indent := indent + ptemp.aindent;
            if token.tokentype <= MAX_TERMINAL then begin  //terminal spaces
              S1 := S1 + dupestring(' ',ptemp.aspace);
              S2 := S2 + dupestring(' ',ptemp.aspace);
            end;
            for i := 1 to ptemp.aeoln do begin
              _addlines(indent);
            end;
            token := PToken(QT.top);
          end;
        end;
      end
      else begin
        if not QT2.isEmpty then begin
          token := PToken(QT2.top);
          while (not QT2.isEmpty) do begin
            token := PToken(QT2.pop);
            ptemp := PTokenData(QT2.pop);
            //apply after section of PTokenData
            if ptemp.aindent < 0 then begin
              if S1 = dupestring(' ',indent) then begin
                if S1 = dupestring(' ',indent) then
                  S1 := dupestring(' ',indent+ptemp.aindent);
                if S2 = dupestring(' ',indent) then
                  S2 := dupestring(' ',indent+ptemp.aindent);
              end;
            end;
            indent := indent + ptemp.aindent;
            if token.tokentype <= MAX_TERMINAL then begin  //terminal spaces
              S1 := S1 + dupestring(' ',ptemp.aspace);
              S2 := S2 + dupestring(' ',ptemp.aspace);
            end;
            for i := 1 to ptemp.aeoln do begin
              _addlines(indent);
            end;
            token := PToken(QT2.top);
          end;
        end;
      end;
*)
(*    if T <> nil then begin
      if not QT.isEmpty then begin
        token := PToken(QT.top);
        while (not QT.isEmpty) do begin
          token := PToken(QT.pop);
          ptemp := PTokenData(QT.pop);
          //apply after section of PTokenData
          ind := ind + ptemp.aindent;
          if token.tokentype <= MAX_TERMINAL then begin  //terminal spaces
            S1 := S1 + dupestring(' ',ptemp.aspace);
            S2 := S2 + dupestring(' ',ptemp.aspace);
          end;
          for i := 1 to ptemp.aeoln do begin
            _addlines(ind);
          end;
        end;
      end;
    end;
*)
(*
    if S1 <> '' then begin
      new(pline1);
      pline1.diffres := -1;
      pline1.colorStrips := colorStrips1;
      Lines1.AddObject(S1,TObject(pline1));
    end;
    if S2 <> '' then begin
      new(pline2);
      pline2.diffres := -1;
      pline2.colorStrips := colorStrips2;
      Lines2.AddObject(S2,TObject(pline2));
    end;
*)
(*
    while (PToken(ln1.i) = ia1[index1]) and (PToken(ln2.i) = ia2[index2]) do begin
      if (p.tokentype < MAX_TERMINAL) then begin
        if p.value = r.value then begin
          S1 := S1 + p.value;
          S2 := S2 + r.value;
        end;
        ln1 := ln1.next;
        ln2 := ln2.next;
        index1 := index1 + 1;
        index2 := index2 + 1;
      end;
      //pridat ind alebo riadok, podla ptokendataline pre p.tokentype

      ln1 := ln1.next;
      ln2 := ln2.next;
      pparent := p;
      p := p.child;
      rparent := r;
      r := r.child;
      while (p = ln1) and (r = ln2) do begin
        if p <> nil then begin

        end;
        _pre(p,r,pparent,rparent,ind);
        p := p.sibling;
      end;
    end;
    if (ln1 = p) or (ln2 <> r) then begin
      _pre(p,r.
    end
    else begin

    end;

    if p = nil then begin
      Exit;
    end;
//    p._parent := parent;

    if p.tokentype < MAX_TERMINAL then begin
      if bNewLine then begin
        S := dupestring(' ',ind);
        bNewLine := false;
      end;
      S := S + p.value + ' ';
      if p.value = ';' then begin
        if (parent = nil) or (not (parent.tokentype = 1000000032)) then begin
//          result.add(S);
          lineno := lineno + 1;
          S := '';
          bNewLine := true;
        end;
      end
      else begin
      end;
    end
    else begin
      parent := p;
      p := p.child;
      while p <> nil do begin
        if p.tokentype = 1000000012 then begin
          ind := ind + 2;
//          result.add(S);
          lineno := lineno + 1;
          S := '';
          bNewLine := true;
        end;
        _pre(p,parent,ind);
        if p.tokentype = 1000000012 then begin
          ind := ind - 2;
        end;
        p := p.sibling;
      end;
    end;
    *)
  end;

var stopwatch: Integer;
begin
  stopwatch := getcurrenttime;
  FileDiffForm.StatusBar1.Panels[4].Text := 'Coloring...';
  ch := 0; cd := 0; ci := 0; cm := 0;

  lineno := 0;
  bNewLine := false;

  ln1 := nil;
  ln2 := nil;
  if L <> nil then begin
    ln1 := L.head;
    if ln1 <> nil then
      ln2 := ln1.next;
  end;

  Lines1 := TStringList.create;
  Lines2 := TStringList.create;

  fillPreOrderArrays(root1,size1,root2,size2);  //1 based!!!, root should NOT have any siblings
  if root1 <> nil then
    root1._parent := nil;
  if root2 <> nil then
    root2._parent := nil;

  QT := TQueueStack.create;
  QT2 := TQueueStack.create;

  index1 := 1;
  index2 := 1;

  diffres := ES_MATCH;

  _init;
  _pre;

  QT.Free;
  QT2.Free;
//  if S <> '' then
//    result.add(S);
  stopwatch := getcurrenttime - stopwatch;

{$IFDEF DEBUG0}
  writeln('Coloring time: ' + IntToStr(stopwatch) + ' ms');
{$ENDIF}
{$IFDEF LOG0}
  LogForm.AddLine('Coloring time: ' + IntToStr(stopwatch) + ' ms');
{$ENDIF}

  if bWantResult then begin
    new(result);
    result.nc := ch;
    result.nd := cd;
    result.ni := ci;
    result.nm := cm;
  end
  else
    result := nil;
end;

/// procedura, ktora naplni globalne polia inorderovym usporiadanim vrcholov vstupnych stromov;
/// root1 je koren vstupneho stromu s velkostou size1;
/// root2 je koren vstupneho stromu s velkostou size2
/// popri tom este pre kazdy vrchol nastavi jeho otca, a index v konkretnom poli a nastavi hodnotu _inorder na 0 (vyuzivane vo FMES algoritme)
procedure fillInOrderArrays(root1: PToken;size1: Integer;root2: PToken;size2: Integer);  //root should NOT have any siblings
var i,j: Integer;

  procedure inorder(node: PToken; var a: array of PToken);
  var tempnode: PToken;
  begin
    if node = nil then
      Exit;

    if node.child <> nil then begin
      node.child._parent := node;
      inorder(node.child,a);
    end;

    node._inorder := 0;
    node._id := i;
    a[i] := node;
    i := i + 1;

    if node.child <> nil then begin
      tempnode := node.child.sibling;
      while tempnode <> nil do begin
        tempnode._parent := node;
        inorder(tempnode,a);
        tempnode := tempnode.sibling;
      end;
    end;

  end;

  procedure postorder(node: PToken; var a: array of PToken);
  var tempnode: PToken;
      cc1: Integer;
  begin
    if node = nil then
      Exit;

    cc1 := 0;
    node._inorder := 1;  //leaf count

    if node.child <> nil then begin
      node.child._parent := node;
      postorder(node.child,a);
      node._inorder := node.child._inorder;
    end;

    if node.child <> nil then begin
      tempnode := node.child.sibling;
      while tempnode <> nil do begin
        tempnode._parent := node;
        postorder(tempnode,a);
        node._inorder := node._inorder + tempnode._inorder;
        tempnode := tempnode.sibling;
      end;
    end;

    node._hash := 0;
    node._id := i;
    a[i] := node;
    i := i + 1;
  end;

begin
  SetLength(ia1,size1);
  SetLength(ia2,size2);
  i := 0;
  postorder(root1,ia1);
  i := 0;
  postorder(root2,ia2);
end;

/// funkcia vracajuca velkost podstromu zakoreneneho vo vrchole p
function subtreesize(p: PToken): Integer;
var stat: Integer;

  function _subtreesize(x: PToken): Integer;
  begin
    result := 0;
    if (stat <> 0) and (Integer(p) = Integer(x)) then begin
{$IFDEF DEBUG1}
      writeln('Cycling!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
{$ENDIF}
      Exit;
    end;
    stat := stat + 1;
    if x <> nil then begin
      result := 1;
      x := x.child;
      while x <> nil do begin
        result := result + _subtreesize(x);
        x := x.sibling;
      end;
    end;
  end;

begin
  stat := 0;
  result := _subtreesize(p);
end;

/// funkcia porovnavajuca dva vstupne stringy a vracajuca mieru ich zhody (0 - zhodne, 2 - uplne odlisne)
function compare(s1,s2: xString): Real;
var d: Integer;
begin
  if s1 = s2 then begin
    result := 0;
    Exit;
  end
  else if (abs(Length(S1) - Length(S2)) > 100) or (Length(S1) + Length(S2) > 500) then begin
    result := 2;
    Exit;
  end;

  d := calcStringDist(s1,s2);
//  result := (d) / (Length(s1) + Length(s2))
  if (Length(s1) = 0) and (Length(s2) = 0) then
    result := 0
  else
    result := ((d) / (Length(s1) + Length(s2))) * 2;
(*  if s1 = s2 then begin
    result := 0;
  end
  else begin
    result := 0.5;
  end;*)
end;

/// funkcia vracajuca pocet synov pre dany vstupny vrchol
function childcount(p: PToken): Integer;
begin
  if p.child <> nil then begin
    result := 1;
    p := p.child.sibling;
    while p <> nil do begin
      result := result + 1;
      p := p.sibling;
    end;
  end
  else
    result := 0;
end;

/// funkcia vracajuca poziciu daneho vrchola v ramci synov svojho otca (t.j. poriadie medzi surodencami)
function childpos(p: PToken): Integer;  //-1 => fatal error
var parent: PToken;
    i: Integer;
begin
  result := -1;
  parent := p._parent;
  if parent <> nil then begin
    i := 1;
    parent := parent.child;
    while parent <> nil do begin
      if parent = p then begin
        result := i;
        exit;
      end;
      i := i + 1;
      parent := parent.sibling;
    end;
  end
  else begin
    result := 1;
  end;
end;

/// funkcia vracajuca pocet vzajomne namapovanych potomkov medzi potomkami vrcholov p a r
function common(p,r: PToken): Integer;
var array1,array2: intarray;
    size1,size2: Integer;
    d,i,j: Integer;
    pair: PPair;
begin
  size1 := childcount(p);
  size2 := childcount(r);
  if p.child <> nil then begin
    SetLength(array1,size1);
    j := 0;
    p := p.child;
    while p <> nil do begin
      i := Integer(p);
      array1[j] := i;
      j := j + 1;
      p := p.sibling;
    end;
  end
  else
    SetLength(array1,0);

  if r.child <> nil then begin
    SetLength(array2,size2);
    j := 0;
    r := r.child;
    while r <> nil do begin
      if not Mtemp.get(Integer(r),Integer(pair)) then
        i := 0
      else
        i := pair.x;
      array2[j] := i;
      j := j + 1;
      r := r.sibling;
    end;
  end
  else
    SetLength(array2,0);

  d := calcDist_fast(array1,Length(array1),array2,Length(array2));

  result := (size1 + size2 - d) shr 1;

  array1 := nil;
  array2 := nil;
end;

/// funkcia vracajuca podobnost podstromov zakorenenych vo vrcholoch p a r
function similarity(p,r: PToken): Real;
var Q1,Q2: TQueueStack;
    array1,array2: intarray;
    d,i,j: Integer;
    pair: PPair;
    c: Integer;

  procedure preorder(x: PToken; Q: TQueueStack);
  begin
    if x <> nil then begin
      if x.child = nil then begin
        Q.push(Integer(x));
      end
      else begin
        x := x.child;
        while x <> nil do begin
          preorder(x,Q);
          x := x.sibling;
        end;
      end;
    end;
  end;

begin
  Q1 := TQueueStack.create;
  Q2 := TQueueStack.create;

//  preorder(p,Q1);
//  preorder(r,Q2);
  p := p.child;
  r := r.child;
  while p <> nil do begin
    Q1.push(Integer(p));
    p := p.sibling;
  end;
  while r <> nil do begin
    Q2.push(Integer(r));
    r := r.sibling;
  end;

  if Q1 <> nil then begin
    SetLength(array1,Q1.getSize);
    Q1.peekNextReset;
    j := 0;
    while Q1.peekNext(i) do begin
      array1[j] := i;
      j := j + 1;
    end;
  end
  else
    SetLength(array1,0);

  j := 0;
  if Q2 <> nil then begin
    SetLength(array2,Q2.getSize);
    Q2.peekNextReset;
    while Q2.peekNext(i) do begin
      if not Mtemp.get(i,Integer(pair)) then
        i := 0
      else begin
        i := pair.x;
        array2[j] := i;
        j := j + 1;
      end;
    end;
  end
  else
    SetLength(array2,0);

  SetLength(array2,j);

  d := calcDist_fast(array1,Length(array1),array2,Length(array2));
  c := (Q1.getSize + Q2.getSize - d) shr 1;

  d := max(Q1.getSize,Q2.getSize);
  if d <> 0 then
    result := c / d
  else
    result := 0;

  array1 := nil;
  array2 := nil;
  Q1.Free;
  Q2.Free;
end;

/// funkcia vracajuca pribliznu podobnost podstromov zakorenenych vo vrcholoch p a r
function similarity2(p,r: PToken): Real;
var H1,H2: TIntHashSet;
    array1,array2: intarray;
    d,i,j: Integer;
    pair: PPair;
    c: Integer;
    size1,size2: Integer;
    m: Integer;

  procedure preorder(x: PToken; H: TIntHashSet);
  begin
    if (x <> nil) and (x._hash > 0) then begin
      if x.child = nil then begin
        H.add(Integer(x));
      end
      else begin
        x := x.child;
        while x <> nil do begin
          preorder(x,H);
          x := x.sibling;
        end;
      end;
    end;
  end;

begin
  H1 := TIntHashSet.create;
  H2 := TIntHashSet.create;
  preorder(p,H1);
  preorder(r,H2);

  size1 := H1.getSize;
  size2 := H2.getSize;
  c := 0;

  if size1 < Mtemp.getSize then begin
    H1.getNextReset;
    while H1.getNext(i) do begin
      if not Mtemp.get(i,Integer(pair)) then
        j := 0
      else
        j := pair.x;
      if H2.remove(j) then
        c := c + 1;
    end;
  end
  else begin
    Mtemp.getNextReset;
    while Mtemp.getNext(i,Integer(pair)) do begin
      if (H1.isEmpty) or (H2.isEmpty) then
        break
      else begin
        if H1.remove(i) then
          if H2.remove(pair.x) then
            c := c + 1;
      end;
    end;
  end;

  m := max(size1,size2);
  if m <> 0 then
    result := c / m
  else
    result := 0;

  H1.Free;
  H2.Free;
end;

(*
function leafs(p: PToken): Integer;
begin
  result := 1;
end;
*)

/// funkcia vracajuca podobnost listov key1 a key2
/// ak su typy listov rovnake a hodnota podobnejsia ako urcuje konstanta F, tak vrati true, inak false,
/// ak vrati true, tak tieto listy su vhodni kandidati do mapovania
function compfunc_leaf_equal(key1, key2: Integer): Boolean;
var I: Integer;
    p,r: PToken;
begin
  result := false;
  p := PToken(key1);
  r := PToken(key2);
  if (p.tokentype = r.tokentype) then begin
    if compare(p.value,r.value) <= LEAF_EQ_CONST_F then begin
      result := true;
    end;
  end;
end;

/// funkcia vracajuca podobnost vnutornych vrcholov key1 a key2
/// ak pocet vzajomne namapovanych potomkov medzi potomkami vrcholov p a r v pomere k maximu z poctu vrcholov oboch vrcholov
/// je vacsi ako konstanta T, tak vrati true, inak vrati false,
/// ak vrati true, tak tieto vrcholy su vhodni kandidati do mapovania
function compfunc_intnode_equal(key1, key2: Integer): Boolean;
var I: Integer;
    p,r: PToken;
begin
  result := false;
  p := PToken(key1);
  r := PToken(key2);
  if (p.tokentype = r.tokentype) then begin
//    if (common(p,r) / max(childcount(p),childcount(r))) > INTNODE_EQ_CONST_T then begin
//    if similarity(p,r) > INTNODE_EQ_CONST_T then begin
//    if childcount(p) = childcount(r) then begin

//    writeln(p._hash,' / ',p._inorder);
//    writeln(r._hash,' -/- ',r._inorder);
//    if childcount(p) = childcount(r) then begin
    if similarity2(p,r) > INTNODE_EQ_CONST_T then begin
      result := true;
    end;
  end;
end;

(*
function compfunc(key1, key2: Integer): Boolean;
var I: Integer;
begin
  result := false;
  if key1 <> key2 then
    Exit;
  result := true;
end;

function test(const S1: xString; const S2: xString; var es_out: TEditScript): Integer;
var array1,array2: intarray;
begin
  SetLength(array1,Length(S1));
  if Length(S1) > 0 then
    ArrayMemCopyBtoDW(S1[1],array1[0],Length(S1));
  SetLength(array2,Length(S2));
  if Length(S2) > 0 then
    ArrayMemCopyBtoDW(S2[1],array2[0],Length(S2));
  result := calcDiff_comp_func(array1,Length(array1),array2,Length(array2),es_out,compfunc);
  array1 := nil;
  array2 := nil;
end;


function mapping_hash(key, capacity: Integer): DWORD;
var I: Integer;
    k: Integer;
    P: PPair;
begin
  result := 5381;
  P := PPair(key);

  result := result shl 5 + result + P.x;
  result := result shl 5 + result + P.y;

  result := result mod DWORD(capacity);
end;

function mapping_equal(key1, key2: Integer): Boolean;
var P,P2: PPair;
    I: Integer;
begin
  result := false;
  P := PPair(key1);
  P2 := PPair(key2);

  if P.x <> P2.x then
    Exit;

  if P.y <> P2.y then
    Exit;

  result := true;
end;
*)


/// funkcia implementujuca porovnavanie stromom top-down algoritmami, vcetne TreeScore algoritmu popisaneho v diplomovej praci
/// vstupy su nasledovne:
/// root1 je koren vstupneho stromu s velkostou size1;
/// root2 je koren vstupneho stromu s velkostou size2;
/// ruleTable je tabulka pravidiel, ktora vsak obsahuje aj mnoziny mnozin tokenov definujuce skore pre zhodne,ekvivalentne a podobne tokeny;
/// L je vystupne mapovanie vrcholov oboch stromov;
/// bAdvanced je boolean definujuci, ci sa  pri porovnavani pomocou TreeScore algoritmu pouzije verzia,
/// kde sa rozlisuju aj hodnoty v listoch, alebo verzia, kde sa rozlisuju iba labely,
/// ak je bAdvanced = true, tak sa hodnoty v listoch nerozlisuju, ak je bAdvanced = false, tak sa rozlisuju
/// bTopDown je boolean urcujuci, ci sa pouzije jednoduche topdown porovnavanie stromov bez pocitania skore, alebo sa pouzije TreeScore algoritmus
/// vystupom je vysledok porovnavania - celkove skore vstupnych stromov
/// viac informacii o algoritme a jeho popis sa nachadza v diplomovej praci
function compareTrees3(root1: PToken;size1: Integer;root2: PToken;size2: Integer; ruletable: TRuleTable; var L: PIntList; bAdvanced: Boolean = false; bTopDown: Boolean = false): PTreeCompareResult;
var nd,ni,nm,nc: Integer;
    iter: Integer;

  function getscore(p: PToken; r: PToken): Integer;
  var i,j: Integer;
      cc1,cc2: Integer;
      D: array of array of Integer;
      W: array of array of Integer;
      A,B: array of PToken;
      t: PToken;
      m1,m2,m3: Integer;

  begin
    if p.tokentype <> r.tokentype then begin
      result := 0;
      Exit;
    end;

    cc1 := childcount(p);
    cc2 := childcount(r);

    SetLength(A,cc1+1);
    SetLength(B,cc2+1);
    i := 1;
    t := p.child;
    while t <> nil do begin
      A[i] := t;
      t := t.sibling;
      i := i + 1;
    end;
    i := 1;
    t := r.child;
    while t <> nil do begin
      B[i] := t;
      t := t.sibling;
      i := i + 1;
    end;

    SetLength(D,cc1+1);
    for i := 0 to cc1 do
      SetLength(D[i],cc2+1);

    for i := 0 to cc1 do
      D[i,0] := 0;
    for j := 0 to cc2 do
      D[0,j] := 0;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin
        m1 := D[i-1,j];
        m2 := D[i,j-1];
        m3 := D[i-1,j-1] + getscore(A[i],B[j]);
        D[i,j] := max(m1,max(m2,m3));
      end;
    end;
    result := D[cc1,cc2] + 1;

    A := nil;
    B := nil;
    for i := 0 to cc1 do
      D[i] := nil;
    D := nil;
  end;

  function getscore1(p: PToken; r: PToken; var M: TQueueStack): Integer;
  var i,j: Integer;
      cc1,cc2: Integer;
      D: array of array of Integer;
      W: array of array of Integer;
      MP: array of array of TQueueStack;
      A,B: array of PToken;
      t: PToken;
      m1,m2,m3: Integer;
  begin
    if p.tokentype <> r.tokentype then begin
      result := 0;
      M := TQueueStack.create;
      Exit;
    end;

    cc1 := childcount(p);
    cc2 := childcount(r);

    SetLength(A,cc1+1);
    SetLength(B,cc2+1);
    i := 1;
    t := p.child;
    while t <> nil do begin
      A[i] := t;
      t := t.sibling;
      i := i + 1;
    end;
    i := 1;
    t := r.child;
    while t <> nil do begin
      B[i] := t;
      t := t.sibling;
      i := i + 1;
    end;

    SetLength(D,cc1+1,cc2+1);
    SetLength(MP,cc1+1,cc2+1);

    for i := 0 to cc1 do
      D[i,0] := 0;
    for j := 0 to cc2 do
      D[0,j] := 0;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin

        m2 := D[i-1,j];
        m3 := D[i,j-1];
        m1 := D[i-1,j-1] + getscore1(A[i],B[j],M);


        if m1 > m2 then begin
          if m1 > m3 then begin

            MP[i,j] := M;
            D[i,j] := m1;
          end
          else begin

//            M.clear;
//            MP[i,j] := M;
            M.Free;
            MP[i,j] := nil;
            D[i,j] := m3;
          end;
        end
        else begin
          if m2 > m3 then begin

//            M.clear;
//            MP[i,j] := M;
            M.Free;
            MP[i,j] := nil;
            D[i,j] := m2;
          end
          else begin

//            M.clear;
//            MP[i,j] := M;
            M.Free;
            MP[i,j] := nil;
            D[i,j] := m3;
          end;
        end;
//        M.Free;
      end;
    end;
    result := D[cc1,cc2] + 1;

    M := TQueueStack.create;
    i := cc1;
    j := cc2;
    while (i >= 1) and (j >= 1) do begin
      if MP[i,j] <> nil then begin
        m1 := MP[i,j].getSize shr 1;
      end
      else begin
        m1 := 0;
      end;
      if D[i-1,j] + m1 = D[i,j] then begin

        if m1 <> 0 then
          M.moveQueueStack(MP[i,j]);
        i := i - 1;
      end
      else if D[i,j-1] + m1 = D[i,j] then begin

        if m1 <> 0 then
          M.moveQueueStack(MP[i,j]);
        j := j - 1;
      end
      else begin

        if m1 <> 0 then
          M.moveQueueStack(MP[i,j]);
        i := i - 1;
        j := j - 1;
      end;
    end;

    M.push(Integer(p));
    M.push(Integer(r));

    A := nil;
    B := nil;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin
        MP[i,j].Free;
      end;
//      MP[i] := nil;
    end;
    MP := nil;
  end;

  function getscore1app(p: PToken; r: PToken; var L: PIntList): Integer;
  var i,j: Integer;
      cc1,cc2: Integer;
      D: array of array of Integer;
      MP: array of array of PIntList;
      A,B: array of PToken;
      t: PToken;
      m1,m2,m3: Integer;
  begin
    if p.tokentype <> r.tokentype then begin
      result := 0;
      L := newlist;
      Exit;
    end;

    cc1 := childcount(p);
    cc2 := childcount(r);

    SetLength(A,cc1+1);
    SetLength(B,cc2+1);
    i := 1;
    t := p.child;
    while t <> nil do begin
      A[i] := t;
      t := t.sibling;
      i := i + 1;
    end;
    i := 1;
    t := r.child;
    while t <> nil do begin
      B[i] := t;
      t := t.sibling;
      i := i + 1;
    end;

    SetLength(D,cc1+1);
    for i := 0 to cc1 do
      SetLength(D[i],cc2+1);

    SetLength(MP,cc1+1);
    for i := 0 to cc1 do
      SetLength(MP[i],cc2+1);

    for i := 0 to cc1 do
      D[i,0] := 0;
    for j := 0 to cc2 do
      D[0,j] := 0;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin

        m2 := D[i-1,j];
        m3 := D[i,j-1];
        m1 := D[i-1,j-1] + getscore1app(A[i],B[j],L);

        if m1 > m2 then begin
          if m1 > m3 then begin
            MP[i,j] := L;
            D[i,j] := m1;
          end
          else begin
            freelist(L);
            MP[i,j] := nil;
            D[i,j] := m3;
          end;
        end
        else begin
          if m2 > m3 then begin
            freelist(L);
            MP[i,j] := nil;
            D[i,j] := m2;
          end
          else begin
            freelist(L);
            MP[i,j] := nil;
            D[i,j] := m3;
          end;
        end;
      end;
    end;
    result := D[cc1,cc2] + 1;

    L := newlist;
    i := cc1;
    j := cc2;
    while (i >= 1) and (j >= 1) do begin
      if D[i-1,j] = D[i,j] then begin
        i := i - 1;
      end
      else if D[i,j-1] = D[i,j] then begin
        j := j - 1;
      end
      else begin
        appendtolist(L,MP[i,j]);
        i := i - 1;
        j := j - 1;
      end;
    end;

    appendInteger(L,Integer(p));
    appendInteger(L,Integer(r));

    A := nil;
    B := nil;
    for i := 0 to cc1 do
      D[i] := nil;
    D := nil;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin
        freelist(MP[i,j]);
      end;
      MP[i] := nil;
    end;
    MP := nil;
  end;

  function getscore1pre(p: PToken; r: PToken; var L: PIntList): Integer;
  var i,j: Integer;
      cc1,cc2: Integer;
      D: array of array of Integer;
      MP: array of array of PIntList;
      A,B: array of PToken;
      t: PToken;
      m1,m2,m3: Integer;
  begin
    iter := iter + 1;
    if iter and CYCLE_THRESHOLD = 0 then begin
      FileDiffForm.StatusBar1.Panels[2].Text := IntToStr(iter);
      Application.ProcessMessages;
    end;
    if p.tokentype <> r.tokentype then begin
      result := 0;
      L := newlist;
      Exit;
    end;

    if p._id <> r._id then begin
      result := 0;
      L := newlist;
      Exit;
    end;

    cc1 := p._inorder; //childcount(p);
    cc2 := r._inorder; //childcount(r);

    if cc1 * cc2 > SANE_ARRAY_SIZE_LIMIT then begin
      LogForm.AddLine('Array size limit exceeded: array ' + IntToStr(cc1) + 'x' + IntToStr(cc2) + ' not created!');
      result := 0;
      L := newlist;
      Exit;
    end;

    SetLength(A,cc1+1);
    SetLength(B,cc2+1);
    i := 1;
    t := p.child;
    while t <> nil do begin
      A[i] := t;
      t := t.sibling;
      i := i + 1;
    end;
    i := 1;
    t := r.child;
    while t <> nil do begin
      B[i] := t;
      t := t.sibling;
      i := i + 1;
    end;

    SetLength(D,cc1+1);
    for i := 0 to cc1 do
      SetLength(D[i],cc2+1);

    SetLength(MP,cc1+1);
    for i := 0 to cc1 do
      SetLength(MP[i],cc2+1);

    for i := 0 to cc1 do
      D[i,0] := 0;
    for j := 0 to cc2 do
      D[0,j] := 0;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin
        if FGlobalHalt then begin
          MP[i,j] := nil;
          continue;
        end;

        m2 := D[i-1,j];
        m3 := D[i,j-1];
        m1 := D[i-1,j-1] + getscore1pre(A[i],B[j],L);

        if m1 > m2 then begin
          if m1 > m3 then begin
            MP[i,j] := L;
            D[i,j] := m1;
          end
          else begin
            freelist(L);
            MP[i,j] := nil;
            D[i,j] := m3;
          end;
        end
        else begin
          if m2 > m3 then begin
            freelist(L);
            MP[i,j] := nil;
            D[i,j] := m2;
          end
          else begin
            freelist(L);
            MP[i,j] := nil;
            D[i,j] := m3;
          end;
        end;
      end;
    end;
    result := D[cc1,cc2] + 1;

    L := newlist;
    i := cc1;
    j := cc2;
    while (i >= 1) and (j >= 1) do begin
      if D[i-1,j] = D[i,j] then begin
        i := i - 1;
      end
      else if D[i,j-1] = D[i,j] then begin
        j := j - 1;
      end
      else begin
        prependtolist(L,MP[i,j]);
        i := i - 1;
        j := j - 1;
      end;
    end;

    prependInteger(L,Integer(r));
    prependInteger(L,Integer(p));

    A := nil;
    B := nil;
    for i := 0 to cc1 do
      D[i] := nil;
    D := nil;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin
        freelist(MP[i,j]);
      end;
      MP[i] := nil;
    end;
    MP := nil;
  end;

  function subtreesequivalentlist(p: PToken; r: PToken): PIntList;
  begin
    result := nil;
    if (p = nil) or (r = nil) then
      Exit;

    result := newlist;
    prependInteger(result,Integer(r));
    prependInteger(result,Integer(p));

    p := p.child;
    r := r.child;
    while (p <> nil) and (r <> nil) do begin
      L := subtreesequivalentlist(p,r);
      appendtolist(result,L);
      p := p.sibling;
      r := r.sibling;
    end;
  end;

{  function subtreesequivalentlist2(p: PToken; r: PToken; var addscore: Integer): PIntList;
  var j,i1: Integer;
      hashset: TIntHashSet;
      h: Integer;
  begin
    result := nil;
    h := 0;

    if (p = nil) or (r = nil) then
      Exit;

    result := newlist;
    prependInteger(result,Integer(r));
    prependInteger(result,Integer(p));

    p := p.child;
    r := r.child;
    while (p <> nil) and (r <> nil) do begin
//      L := subtreesequivalentlist2(p,r,h);
      L := subtreesequivalentlist2(p,r,addscore);

(*      if p.tokentype <> r.tokentype then begin
        writeln(p.tokentype,':',r.tokentype,'(',p._hash,',',r._hash,') - ',p.value,':',r.value);
      end;*)

//      if (p.child = nil) and (r.child = nil) then
      j := 0;
      if (p.value <> '') and (p.value = r.value) then begin
        if (ruletable = nil) then begin
          j := 1;
        end
        else begin
          if (ruletable.FEquivalentIndices = nil) then begin
            j := ruletable.FDefEqScore;
          end
          else begin
            if ruletable.FEquivalentIndices.get(p.tokentype,i1) then begin
              if ruletable.FEquivalenceSets.get(i1,Integer(hashset)) then
                j := hashset.tag2
              else
                j := ruletable.FDefEqScore;
            end
            else begin
              j := ruletable.FDefEqScore;
            end
          end;
        end;
//        h := h + j;
//        addscore := addscore + j;
      end;

      if p.tokentype = r.tokentype then begin
        appendtolist(result,L);
        addscore := addscore + j;
      end;

      p := p.sibling;
      r := r.sibling;
    end;
  end;
}

  function subtreesequivalentlist2(p: PToken; r: PToken; var addscore: Integer): PIntList;
  var j,i1: Integer;
      hashset: TIntHashSet;
      k,h: Integer;
  begin
    result := nil;
    h := 0;
    k := 0;

    if (p = nil) or (r = nil) then
      Exit;

    result := newlist;
    prependInteger(result,Integer(r));
    prependInteger(result,Integer(p));

    j := 0;
      if p.tokentype = r.tokentype then begin
        if (p.tokentype <= MAX_TERMINAL) and (r.tokentype <= MAX_TERMINAL) and (p.value = r.value) then begin
          if (ruletable = nil) then begin
            j := 1;
          end
          else begin
            if (ruletable.FEquivalentIndices = nil) then begin
              j := ruletable.FDefEqScore2;
            end
            else begin
              if ruletable.FEquivalentIndices.get(p.tokentype,i1) then begin
                if ruletable.FEquivalenceSets.get(i1,Integer(hashset)) then
                  j := hashset.tag2
                else
                  j := ruletable.FDefEqScore2;
              end
              else begin
                j := ruletable.FDefEqScore2;
              end
            end;
          end;
        end;
      end
      else begin
        addscore := -1;
        Exit;
      end;
    k := j;

    p := p.child;
    r := r.child;
    while (p <> nil) and (r <> nil) do begin
      L := subtreesequivalentlist2(p,r,h);
      if h = -1 then begin
        addscore := -1;
        exit;
      end;
      if p.tokentype = r.tokentype then begin
//        j := 0;
        if (p.tokentype <= MAX_TERMINAL) and (r.tokentype <= MAX_TERMINAL) and (p.value = r.value) then begin
          if (ruletable = nil) then begin
            j := 1;
          end
          else begin
            if (ruletable.FEquivalentIndices = nil) then begin
              j := ruletable.FDefEqScore2;
            end
            else begin
              if ruletable.FEquivalentIndices.get(p.tokentype,i1) then begin
                if ruletable.FEquivalenceSets.get(i1,Integer(hashset)) then
                  j := hashset.tag2
                else
                  j := ruletable.FDefEqScore2;
              end
              else begin
                j := ruletable.FDefEqScore2;
              end
            end;
          end;
        end;

        appendtolist(result,L);
        h := h + j;
      end
      else begin
        addscore := -1;
        Exit;
      end;

      p := p.sibling;
      r := r.sibling;
    end;
    addscore := addscore + k + h;
  end;

  function subtreesequivalentlist2Eq(p: PToken; r: PToken; var addscore: Integer): PIntList;
  var j,i1: Integer;
      hashset: TIntHashSet;
      h: Integer;
  begin
    result := nil;
    h := 0;

    if (p = nil) or (r = nil) then
      Exit;

    result := newlist;
    prependInteger(result,Integer(r));
    prependInteger(result,Integer(p));

    if (p.tokentype = r.tokentype) and ((p.tokentype > MAX_TERMINAL) or (p.value = r.value)) then begin
    end
    else begin
      addscore := -1;
      Exit;
    end;
    addscore := addscore + 1;

    p := p.child;
    r := r.child;
    while (p <> nil) and (r <> nil) do begin
      L := subtreesequivalentlist2Eq(p,r,h);
      if h = -1 then begin
        addscore := -1;
        exit;
      end;
      if (p.tokentype = r.tokentype) and ((p.tokentype > MAX_TERMINAL) or (p.value = r.value)) then begin
        appendtolist(result,L);
      end
      else begin
        addscore := -1;
        Exit;
      end;
      p := p.sibling;
      r := r.sibling;

      addscore := addscore + h;
    end;
  end;

  function getscore1adv(p: PToken; r: PToken; var L: PIntList): Integer;
  var i,j: Integer;
      cc1,cc2: Integer;
      D: array of array of Integer;
      MP: array of array of PIntList;
      A,B: array of PToken;
      t: PToken;
      m1,m2,m3: Integer;
      i1,i2: Integer;
      hashset: TIntHashSet;
      bEq: Boolean;
      bFound: Boolean;
  begin
    iter := iter + 1;
    if iter and CYCLE_THRESHOLD = 0 then begin
      FileDiffForm.StatusBar1.Panels[2].Text := IntToStr(iter);
      Application.ProcessMessages;
    end;
    bEq := true;
//    writeln(p.value,' - ',r.value);
    if (p._hash = r._hash) then begin //and (p.child <> nil) then begin
      result := p._id;  //score
      j := 0;
      L := subtreesequivalentlist2(p,r,j);
      result := result + j;
      if j > -1 then begin
        if L = nil then
          L := newlist;
        Exit;
      end
      else begin
        freelist(L);
        L := nil;
      end;
    end;
    if (ruletable.FEquivalentIndices = nil) and (ruletable.FSimilarIndices = nil) then begin
      if p.tokentype = r.tokentype then
        result := ruletable.FDefEqScore
      else begin
        bEq := false;
        result := 0;
        L := newlist;
        Exit;
      end;
    end
    else if ruletable.FEquivalentIndices = nil then begin
      if p.tokentype = r.tokentype then
        result := ruletable.FDefEqScore
      else begin
        bEq := false;
        bFound := ruletable.FSimilarIndices.get(p.tokentype,i1);
        if bFound then
          bFound := ruletable.FSimilarIndices.get(r.tokentype,i2);
        if (bFound) and (i1 = i2) then begin
          if ruletable.FSimilaritySets.get(i1,Integer(hashset)) then
            result := hashset.tag
          else
            result := ruletable.FDefSimScore;
        end
        else begin
          result := 0;
          L := newlist;
          Exit;
        end;
      end;
    end
    else if ruletable.FSimilarIndices = nil then begin
      bFound := ruletable.FEquivalentIndices.get(p.tokentype,i1);
      if bFound then
        bFound := ruletable.FEquivalentIndices.get(r.tokentype,i2);
      if (bFound) and (i1 = i2) then begin
        if ruletable.FEquivalenceSets.get(i1,Integer(hashset)) then
          result := hashset.tag
        else
          result := ruletable.FDefEqScore;
      end
      else begin
        if p.tokentype = r.tokentype then
          result := ruletable.FDefEqScore
        else begin
          bEq := false;
          result := 0;
          L := newlist;
          Exit;
        end;
      end;
    end
    else begin
      bFound := ruletable.FEquivalentIndices.get(p.tokentype,i1);
      if bFound then
        bFound := ruletable.FEquivalentIndices.get(r.tokentype,i2);
      if (bFound) and (i1 = i2) then begin
        if ruletable.FEquivalenceSets.get(i1,Integer(hashset)) then
          result := hashset.tag
        else
          result := ruletable.FDefEqScore;
      end
      else begin
        if p.tokentype = r.tokentype then
          result := ruletable.FDefEqScore
        else begin
          bEq := false;
          bFound := ruletable.FSimilarIndices.get(p.tokentype,i1);
          if bFound then
            bFound := ruletable.FSimilarIndices.get(r.tokentype,i2);
          if (bFound) and (i1 = i2) then begin
            if ruletable.FSimilaritySets.get(i1,Integer(hashset)) then
              result := hashset.tag
            else
              result := ruletable.FDefSimScore;
          end
          else begin
            result := 0;
            L := newlist;
            Exit;
          end;
        end;
      end;
    end;

    cc1 := p._inorder; //childcount(p);
    cc2 := r._inorder; //childcount(r);

    if cc1 * cc2 > SANE_ARRAY_SIZE_LIMIT then begin
      LogForm.AddLine('Array size limit exceeded: array ' + IntToStr(cc1) + 'x' + IntToStr(cc2) + ' not created!');
      result := 0;
      L := newlist;
      Exit;
    end;

    SetLength(A,cc1+1);
    SetLength(B,cc2+1);
    i := 1;
    t := p.child;
    while t <> nil do begin
      A[i] := t;
      t := t.sibling;
      i := i + 1;
    end;
    i := 1;
    t := r.child;
    while t <> nil do begin
      B[i] := t;
      t := t.sibling;
      i := i + 1;
    end;

    SetLength(D,cc1+1);
    for i := 0 to cc1 do
      SetLength(D[i],cc2+1);

    SetLength(MP,cc1+1);
    for i := 0 to cc1 do
      SetLength(MP[i],cc2+1);

    for i := 0 to cc1 do
      D[i,0] := 0;
    for j := 0 to cc2 do
      D[0,j] := 0;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin
        if FGlobalHalt then begin
          MP[i,j] := nil;
          continue;
        end;
        m2 := D[i-1,j];
        m3 := D[i,j-1];
        m1 := D[i-1,j-1] + getscore1adv(A[i],B[j],L);

        if m1 > m2 then begin
          if m1 > m3 then begin
            MP[i,j] := L;
            D[i,j] := m1;
          end
          else begin
            freelist(L);
            MP[i,j] := nil;
            D[i,j] := m3;
          end;
        end
        else begin
          if m2 > m3 then begin
            freelist(L);
            MP[i,j] := nil;
            D[i,j] := m2;
          end
          else begin
            freelist(L);
            MP[i,j] := nil;
            D[i,j] := m3;
          end;
        end;
      end;
    end;

    if (result > 0) and (cc1 = cc2) then
      result := result + 1;

    result := result + D[cc1,cc2];

    L := newlist;
    i := cc1;
    j := cc2;
    if not FGlobalHalt then
      while (i >= 1) and (j >= 1) do begin
        if D[i-1,j] = D[i,j] then begin
          i := i - 1;
        end
        else if D[i,j-1] = D[i,j] then begin
          j := j - 1;
        end
        else begin
          prependtolist(L,MP[i,j]);
          i := i - 1;
          j := j - 1;
        end;
      end;

    prependInteger(L,Integer(r));
    prependInteger(L,Integer(p));

    A := nil;
    B := nil;
    for i := 0 to cc1 do
      D[i] := nil;
    D := nil;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin
        freelist(MP[i,j]);
      end;
      MP[i] := nil;
    end;
    MP := nil;
  end;

{  function subtreesequivalentlist2Eq(p: PToken; r: PToken; var addscore: Integer): PIntList;
  var j,i1: Integer;
      hashset: TIntHashSet;
      h: Integer;
  begin
    result := nil;
    h := 0;

    if (p = nil) or (r = nil) then
      Exit;

    result := newlist;
    prependInteger(result,Integer(r));
    prependInteger(result,Integer(p));

    p := p.child;
    r := r.child;
    while (p <> nil) and (r <> nil) do begin
      L := subtreesequivalentlist2Eq(p,r,h);

//      if (p.child = nil) and (r.child = nil) then
      if (p.value <> '') and (p.value = r.value) then begin
        if (ruletable = nil) then begin
          j := 1;
        end
        else begin
          if (ruletable.FEquivalentIndices = nil) then begin
            j := ruletable.FDefEqScore;
          end
          else begin
            if ruletable.FEquivalentIndices.get(p.tokentype,i1) then begin
              if ruletable.FEquivalenceSets.get(i1,Integer(hashset)) then
                j := hashset.tag2
              else
                j := ruletable.FDefEqScore;
            end
            else begin
              j := ruletable.FDefEqScore;
            end
          end;
        end;
        h := h + j;
      end;

      if p.tokentype = r.tokentype then begin
        appendtolist(result,L);
        addscore := addscore + h;
      end;
      p := p.sibling;
      r := r.sibling;
    end;
  end;
}

  function getscore1advEq(p: PToken; r: PToken; var L: PIntList): Integer;
  var i,j: Integer;
      cc1,cc2: Integer;
      D: array of array of Integer;
      MP: array of array of PIntList;
      A,B: array of PToken;
      t: PToken;
      m1,m2,m3: Integer;
      i1,i2: Integer;
      hashset: TIntHashSet;
      bEq: Boolean;
      bFound: Boolean;
  begin
    iter := iter + 1;
    if iter and CYCLE_THRESHOLD = 0 then begin
      FileDiffForm.StatusBar1.Panels[2].Text := IntToStr(iter);
      Application.ProcessMessages;
    end;
    bEq := true;
//    writeln(p.value,' - ',r.value);
    if (p._hash = r._hash) then begin //and (p.child <> nil) then begin
      result := p._id;  //score
      j := 0;
      L := subtreesequivalentlist2Eq(p,r,j);
//      result := result + j;
      if j > -1 then begin
        if L = nil then
          L := newlist;
        Exit;
      end
      else begin
        freelist(L);
        L := nil;
      end;
    end;
    if (ruletable.FEquivalentIndices = nil) and (ruletable.FSimilarIndices = nil) then begin
      if p.tokentype = r.tokentype then
        result := ruletable.FDefEqScore
      else begin
        bEq := false;
        result := 0;
        L := newlist;
        Exit;
      end;
    end
    else if ruletable.FEquivalentIndices = nil then begin
      if p.tokentype = r.tokentype then
        result := ruletable.FDefEqScore
      else begin
        bEq := false;
          bFound := ruletable.FSimilarIndices.get(p.tokentype,i1);
          if bFound then
            bFound := ruletable.FSimilarIndices.get(r.tokentype,i2);
          if (bFound) and (i1 = i2) then begin
          if ruletable.FSimilaritySets.get(i1,Integer(hashset)) then
            result := hashset.tag
          else
            result := ruletable.FDefSimScore;
        end
        else begin
          result := 0;
          L := newlist;
          Exit;
        end;
      end;
    end
    else if ruletable.FSimilarIndices = nil then begin
      bFound := ruletable.FEquivalentIndices.get(p.tokentype,i1);
      if bFound then
        bFound := ruletable.FEquivalentIndices.get(r.tokentype,i2);
      if (bFound) and (i1 = i2) then begin
        if ruletable.FEquivalenceSets.get(i1,Integer(hashset)) then
          result := hashset.tag
        else
          result := ruletable.FDefEqScore;
      end
      else begin
        if p.tokentype = r.tokentype then
          result := ruletable.FDefEqScore
        else begin
          bEq := false;
          result := 0;
          L := newlist;
          Exit;
        end;
      end;
    end
    else begin
      bFound := ruletable.FEquivalentIndices.get(p.tokentype,i1);
      if bFound then
        bFound := ruletable.FEquivalentIndices.get(r.tokentype,i2);
      if (bFound) and (i1 = i2) then begin
        if ruletable.FEquivalenceSets.get(i1,Integer(hashset)) then
          result := hashset.tag
        else
          result := ruletable.FDefEqScore;
      end
      else begin
        if p.tokentype = r.tokentype then
          result := ruletable.FDefEqScore
        else begin
          bEq := false;
          bFound := ruletable.FSimilarIndices.get(p.tokentype,i1);
          if bFound then
            bFound := ruletable.FSimilarIndices.get(r.tokentype,i2);
          if (bFound) and (i1 = i2) then begin
            if ruletable.FSimilaritySets.get(i1,Integer(hashset)) then
              result := hashset.tag
            else
              result := ruletable.FDefSimScore;
          end
          else begin
            result := 0;
            L := newlist;
            Exit;
          end;
        end;
      end;
    end;

    cc1 := p._inorder; //childcount(p);
    cc2 := r._inorder; //childcount(r);

    if cc1 * cc2 > SANE_ARRAY_SIZE_LIMIT then begin
      LogForm.AddLine('Array size limit exceeded: array ' + IntToStr(cc1) + 'x' + IntToStr(cc2) + ' not created!');
      result := 0;
      L := newlist;
      Exit;
    end;

    SetLength(A,cc1+1);
    SetLength(B,cc2+1);
    i := 1;
    t := p.child;
    while t <> nil do begin
      A[i] := t;
      t := t.sibling;
      i := i + 1;
    end;
    i := 1;
    t := r.child;
    while t <> nil do begin
      B[i] := t;
      t := t.sibling;
      i := i + 1;
    end;

    SetLength(D,cc1+1);
    for i := 0 to cc1 do
      SetLength(D[i],cc2+1);

    SetLength(MP,cc1+1);
    for i := 0 to cc1 do
      SetLength(MP[i],cc2+1);

    for i := 0 to cc1 do
      D[i,0] := 0;
    for j := 0 to cc2 do
      D[0,j] := 0;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin
        if FGlobalHalt then begin
          MP[i,j] := nil;
          continue;
        end;
        m2 := D[i-1,j];
        m3 := D[i,j-1];
        m1 := D[i-1,j-1] + getscore1advEq(A[i],B[j],L);

        if m1 > m2 then begin
          if m1 > m3 then begin
            MP[i,j] := L;
            D[i,j] := m1;
          end
          else begin
            freelist(L);
            MP[i,j] := nil;
            D[i,j] := m3;
          end;
        end
        else begin
          if m2 > m3 then begin
            freelist(L);
            MP[i,j] := nil;
            D[i,j] := m2;
          end
          else begin
            freelist(L);
            MP[i,j] := nil;
            D[i,j] := m3;
          end;
        end;
      end;
    end;

    if (result > 0) and (cc1 = cc2) then
      result := result + 1;

    result := result + D[cc1,cc2];

    L := newlist;
    i := cc1;
    j := cc2;
    if not FGlobalHalt then
      while (i >= 1) and (j >= 1) do begin
        if D[i-1,j] = D[i,j] then begin
          i := i - 1;
        end
        else if D[i,j-1] = D[i,j] then begin
          j := j - 1;
        end
        else begin
          prependtolist(L,MP[i,j]);
          i := i - 1;
          j := j - 1;
        end;
      end;

    prependInteger(L,Integer(r));
    prependInteger(L,Integer(p));

    A := nil;
    B := nil;
    for i := 0 to cc1 do
      D[i] := nil;
    D := nil;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin
        freelist(MP[i,j]);
      end;
      MP[i] := nil;
    end;
    MP := nil;
  end;

  function getscore2(p: PToken; r: PToken; var M: TQueueStack): Integer;
  var i,j: Integer;
      cc1,cc2: Integer;
      oldD,D,tempD: array of Integer;
      A,B: array of PToken;
      t: PToken;
      m1,m2,m3: Integer;
      oldMP,MP,tempMP: array of TQueueStack;
  begin
    if p.tokentype <> r.tokentype then begin
      result := 0;
      M := TQueueStack.create;
      Exit;
    end;

    cc1 := childcount(p);
    cc2 := childcount(r);

    SetLength(A,cc1+1);
    SetLength(B,cc2+1);
    i := 1;
    t := p.child;
    while t <> nil do begin
      A[i] := t;
      t := t.sibling;
      i := i + 1;
    end;
    i := 1;
    t := r.child;
    while t <> nil do begin
      B[i] := t;
      t := t.sibling;
      i := i + 1;
    end;

    SetLength(oldD,cc2+1);
    SetLength(D,cc2+1);
    SetLength(oldMP,cc2+1);
    SetLength(MP,cc2+1);

    for i := 0 to cc2 do begin
      oldD[i] := 0;
      D[i] := 0;
//      oldMP[i] := nil;
//      MP[i] := nil;
      oldMP[i] := TQueueStack.create;
      MP[i] := TQueueStack.create;
    end;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin

        m2 := oldD[j];
        m3 := D[j-1];
        m1 := oldD[j-1] + getscore2(A[i],B[j],M);

        if m1 > m2 then begin
          if m1 > m3 then begin
            MP[j].clear;
            MP[j].moveQueueStack(oldMP[j-1]);
            MP[j].moveQueueStack(M);
            D[j] := m1;
          end
          else begin
            MP[j].clear;
            MP[j].addQueueStack(MP[j-1]);
            D[j] := m3;
          end;
        end
        else begin
          if m2 > m3 then begin
            MP[j].clear;
            MP[j].addQueueStack(oldMP[j]);
            D[j] := m2;
          end
          else begin
            MP[j].clear;
            MP[j].addQueueStack(MP[j-1]);
            D[j] := m3;
          end;
        end;
        M.Free;
      end;
      tempD := oldD;
      oldD := D;
      D := tempD;
      tempMP := oldMP;
      oldMP := MP;
      MP := tempMP;
    end;
    result := oldD[cc2] + 1;
    M := oldMP[cc2].clone;
    M.push(Integer(p));
    M.push(Integer(r));

    A := nil;
    B := nil;
    D := nil;
    oldD := nil;

    for i := 0 to cc2 do
      MP[i].Free;
    MP := nil;
    for i := 0 to cc2 do
      oldMP[i].Free;
    oldMP := nil;
  end;

  function getscore2adv(p: PToken; r: PToken; var L: PIntList): Integer;
  var i,j: Integer;
      cc1,cc2: Integer;
      oldD,D,tempD: array of Integer;
      A,B: array of PToken;
      t: PToken;
      m1,m2,m3: Integer;
      oldMP,MP,tempMP: array of PIntList;
      X: PIntList;
  begin
    if p.tokentype <> r.tokentype then begin
      result := 0;
      L := newlist;
      Exit;
    end
    else begin
      result := 1;
    end;

    cc1 := childcount(p);
    cc2 := childcount(r);

    SetLength(A,cc1+1);
    SetLength(B,cc2+1);
    i := 1;
    t := p.child;
    while t <> nil do begin
      A[i] := t;
      t := t.sibling;
      i := i + 1;
    end;
    i := 1;
    t := r.child;
    while t <> nil do begin
      B[i] := t;
      t := t.sibling;
      i := i + 1;
    end;

    SetLength(oldD,cc2+1);
    SetLength(D,cc2+1);
    SetLength(oldMP,cc2+1);
    SetLength(MP,cc2+1);

    for i := 0 to cc2 do begin
      oldD[i] := 0;
      D[i] := 0;
//      oldMP[i] := nil;
//      MP[i] := nil;
      oldMP[i] := newlist;
      MP[i] := newlist;
    end;

    for i := 1 to cc1 do begin
      for j := 1 to cc2 do begin

        m2 := oldD[j];
        m3 := D[j-1];
        m1 := oldD[j-1] + getscore2adv(A[i],B[j],L);

        if m1 > m2 then begin
          if m1 > m3 then begin
            clearlist(MP[j]);
            X := clonelist(oldMP[j-1]);
            appendtolist(MP[j],X);
            X := clonelist(L);
            appendtolist(MP[j],X);
            D[j] := m1;
          end
          else begin
            clearlist(MP[j]);
            X := clonelist(MP[j-1]);
            appendtolist(MP[j],X);
            D[j] := m3;
          end;
        end
        else begin
          if m2 > m3 then begin
            clearlist(MP[j]);
            X := clonelist(oldMP[j]);
            appendtolist(MP[j],X);
            D[j] := m2;
          end
          else begin
            clearlist(MP[j]);
            X := clonelist(MP[j-1]);
            appendtolist(MP[j],X);
            D[j] := m3;
          end;
        end;
        freelist(L);
      end;
      tempD := oldD;
      oldD := D;
      D := tempD;
      tempMP := oldMP;
      oldMP := MP;
      MP := tempMP;
    end;
    result := result + oldD[cc2];
//    writeln(result);
    L := clonelist(oldMP[cc2]);
    prependInteger(L,Integer(r));
    prependInteger(L,Integer(p));
//    writeln(listtoString(L));

    A := nil;
    B := nil;
    D := nil;
    oldD := nil;

    for i := 0 to cc2 do
      freelist(MP[i]);
    MP := nil;
    for i := 0 to cc2 do
      freelist(oldMP[i]);
    oldMP := nil;
  end;

var M: TQueueStack;
//    L: PIntList;
    ln: PIntNode;
    i,j: Integer;
    c: Integer;
    stopwatch: Integer;
begin
  result := nil;
  if (root1 = nil) or (root2 = nil) then
    Exit;

  nd := 0; ni := 0; nm := 0; nc := 0; iter := 0;
  FileDiffForm.StatusBar1.Panels[0].Text := 'Number of';
  FileDiffForm.StatusBar1.Panels[1].Text := 'iterations';
  FileDiffForm.StatusBar1.Panels[3].Text := '';
  FileDiffForm.StatusBar1.Panels[4].Text := 'Comparing parse trees...';
//  FileDiffForm.SimpleUpdateStatusBar(nc,nd,ni,nm);
  Application.ProcessMessages;

//  if size1*size2 > 100000 then
//    Exit;

  stopwatch := getcurrenttime;
//  result := getscore(root1,root2);
//  result := getscore2(root1,root2,M);

  new(result);
  if bTopDown then begin
    fillSimplePostOrderChildCountAndSize(root1,size1,root2,size2);
    result.score := getscore1pre(root1,root2,L)
  end
  else begin
    if bAdvanced then begin
      fillPostOrderArrays(root1,size1,root2,size2,ruletable);
      result.score := getscore1adv(root1,root2,L)
    end
    else begin
      fillPostOrderArraysWithHashEqValues(root1,size1,root2,size2,ruletable);
      result.score := getscore1advEq(root1,root2,L);
  //    fillPostOrderArrays(root1,size1,root2,size2,ruletable);
  //    result.score := getscore1pre(root1,root2,L);
    end;
  end;
  result.nc := nc;
  result.nd := nd;
  result.ni := ni;
  result.nm := nm;

  stopwatch := getcurrenttime - stopwatch;
{$IFDEF DEBUG0}
  writeln('Struct diff time: ' + IntToStr(stopwatch) + ' ms');
{$ENDIF}
{$IFDEF LOG0}
  LogForm.AddLine('Struct diff time: ' + IntToStr(stopwatch) + ' ms');
{$ENDIF}

(*
  ln := L.tail;
  c := 1;
  while ln <> nil do begin
    j := ln.i;
    ln := ln.prev;
    i := ln.i;
    writeln(c,': ',PToken(i).tokentype,' ',PToken(i).startp,'_',PToken(i).endp,' = ',PToken(j).tokentype,' ',PToken(j).startp,'_',PToken(j).endp);
    c := c + 1;
    ln := ln.prev;
  end;
  freelist(L);
*)
(*
  ln := L.head;
  c := 1;
  while ln <> nil do begin
    i := ln.i;
    ln := ln.next;
    j := ln.i;
    writeln(c,': ',PToken(i).tokentype,' ',PToken(i).startp,'_',PToken(i).endp,' = ',PToken(j).tokentype,' ',PToken(j).startp,'_',PToken(j).endp);
    c := c + 1;
    ln := ln.next;
  end;
*)
//  freelist(L);

(*
  M.peekNextReset;
  c := 1;
  while M.peekNext(i) do begin
    M.peekNext(j);
    writeln(c,': ',PToken(i).tokentype,' ',PToken(i).startp,'_',PToken(i).endp,' = ',PToken(j).tokentype,' ',PToken(j).startp,'_',PToken(j).endp);
    c := c + 1;
  end;

  M.Free;
*)
end;

/// algoritmus porovnavajuci vstupne stromy algoritmom mmdiff (detaily v diplomovej praci)
/// vstupy su nasledovne:
/// root1 je koren vstupneho stromu s velkostou size1;
/// root2 je koren vstupneho stromu s velkostou size2;
/// vystupom je vysledok porovnavania - celkovy pocet rozdielov vstupnych stromov
function compareTrees(root1: PToken;size1: Integer;root2: PToken;size2: Integer): PTreeCompareResult;
const
    INF = 1000000000;
var i,j: Integer;
    m1,m2,m3: Integer;
    p: PToken;
    D: array of array of Integer;
    stopwatch: Cardinal;

  function cdelete(p: PToken): Integer;
  begin
    result := 1;
  end;
  function cinsert(p: PToken): Integer;
  begin
    result := 1;
  end;
  function cupdate(p,r: PToken): Integer;
  begin
    result := 1;
    if p.tokentype = r.tokentype then
      if p.value = r.value then
        result := 0;
  end;

begin
  FileDiffForm.StatusBar1.Panels[4].Text := 'Comparing parse trees...';
  Application.ProcessMessages;
  stopwatch := getcurrenttime;
  new(result);
  result.score := -1;

  fillPreOrderArrays(root1,size1,root2,size2);
  root1._parent := nil;
  root2._parent := nil;

  if size1*size2 > 100000 then
    Exit;

  SetLength(D,size1+1);
  for i := 0 to size1 do
    SetLength(D[i],size2+1);

  D[0,0] := 0;
  for i := 1 to size1 do
    D[i,0] := D[i-1,0] + cdelete(ia1[i]);
  for j := 1 to size2 do
    D[0,j] := D[0,j-1] + cinsert(ia2[j]);

  for i := 1 to size1 do begin
    for j := 1 to size2 do begin
      m1 := INF;
      m2 := INF;
      m3 := INF;
      if ia1[i]._inorder = ia2[j]._inorder then
        m1 := D[i-1,j-1] + cupdate(ia1[i],ia2[j]);
      if (j = size2) or (ia2[j+1]._inorder <= ia1[i]._inorder) then
        m2 := D[i-1,j] + cdelete(ia1[i]);
      if (i = size1) or (ia1[i+1]._inorder <= ia2[j]._inorder) then
        m3 := D[i,j-1] + cinsert(ia2[j]);
      D[i,j] := min(m1,min(m2,m3));
    end;
  end;

  result.score := D[size1,size2];

  i := size1;
  j := size2;
  while (i > 0) and (j > 0) do begin
    if D[i,j] = D[i-1,j] + cdelete(ia1[i]) then begin
{$IFDEF DEBUG1}
      writeln('DELETE A' + IntToStr(i));
      writeln(IntToStr(ia1[i].tokentype) + ' : ' + ia1[i].value);
{$ENDIF}
      i := i - 1;
    end
    else if D[i,j] = D[i,j-1] + cinsert(ia2[j]) then begin
{$IFDEF DEBUG1}
      writeln('INSERT B' + IntToStr(j));
      writeln(IntToStr(ia2[j].tokentype) + ' : ' + ia2[j].value);
{$ENDIF}
      j := j - 1;
    end
    else begin
      if (ia1[i].tokentype <> ia2[j].tokentype) or (ia1[i].value <> ia2[j].value) then begin
{$IFDEF DEBUG1}
        writeln('CHANGE A' + IntToStr(i) + ' to ' + 'B' + IntToStr(j));
        writeln(IntToStr(ia1[i].tokentype) + ' : ' + ia1[i].value);
        writeln(IntToStr(ia2[j].tokentype) + ' : ' + ia2[j].value);
{$ENDIF}
      end;
      i := i - 1;
      j := j - 1;
    end;
  end;
  while (i > 0) do begin
{$IFDEF DEBUG1}
      writeln('DELETE A' + IntToStr(i));
{$ENDIF}
      i := i - 1;
  end;
  while (j > 0) do begin
{$IFDEF DEBUG1}
      writeln('INSERT B' + IntToStr(j));
{$ENDIF}
      j := j - 1;
  end;

  D := nil;

  ia1 := nil;
  ia2 := nil;

  stopwatch := getcurrenttime - stopwatch;
{$IFDEF DEBUG0}
  writeln('Time elapsed comparing tree structures: ' + IntToStr(stopwatch) + ' ms');
{$ENDIF}
{$IFDEF LOG0}
  LogForm.AddLine('Time elapsed comparing tree structures: ' + IntToStr(stopwatch) + ' ms');
{$ENDIF}
end;

/// funkcia vracajuca, ci su vstupne vrcholy key1 a key2 v mapovani
function equalfunc(key1, key2: Integer): Boolean;
var I: Integer;
    P: PPair;
begin
  result := false;
  if Mtemp.get(key1,Integer(P)) then begin
    if P.x = key2 then begin
      result := true;
    end;
  end;
end;

/// algoritmus porovnavajuci vstupne stromy algoritmom FMES (detaily v diplomovej praci)
/// vstupy su nasledovne:
/// root1 je koren vstupneho stromu s velkostou size1 (strom A);
/// root2 je koren vstupneho stromu s velkostou size2 (strom B);
/// vystupom je vysledok porovnavania - celkovy pocet vlozeni,vymazani,modifikacii a presunov vrcholov vstupneho stromu A
/// potrebnych k tomu aby sa transformoval na strom izomorfny so strom B
function compareTrees2(root1: PToken;size1: Integer;root2: PToken;size2: Integer): PTreeCompareResult;
var i: Integer;
    chainsSet,chainsSet2: TIntIntHashSet;
    Q: TQueueStack;
    a1,a2: array of PToken;
    leafslabelsSet,intnodeslabelsSet: TIntHashSet;
    l: Integer;
    Q1,Q2,Q1u,Q2u: TQueueStack;
    x,y: Integer;
    P,P2: PPair;
    M,Mnew: TIntIntHashSet;  //mapping
    ES: TQueueStack;
    nodeX,nodeY,nodeZ,nodeV,nodeW,tempnode: PToken;
    k: Integer;
    size1new: Integer;
    fast_match_time,edit_script_time: Integer;
    b,bCycle: Boolean;
    firstchild,lastchild: PToken;
    ch,cd,ci,cm,cmove: Integer;

  procedure correctFastMatch;
  var C,CI: TQueueStack;
      X,Y,W,Z,tempnode,tempnodeX: PToken;
      P: PPair;
  begin
    C := TQueueStack.create;
    C.push(Integer(root2));
    while not C.isEmpty do begin
      Application.ProcessMessages;
      if FGlobalHalt then
        break;

      Y := PToken(C.dequeue);
      tempnode := Y.child;
      while tempnode <> nil do begin
        C.push(Integer(tempnode));
        tempnode := tempnode.sibling;
      end;

      if M.get(Integer(Y),Integer(P)) then begin
        Z := PToken(P.x);
        X := Y.child;
        while X <> nil do begin
          if M.get(Integer(X),Integer(P)) then begin
            W := PToken(P.x);
            if W._parent <> Z then begin
              tempnode := Z.child;
              while tempnode <> nil do begin
                if tempnode.child = nil then begin
                  if compfunc_leaf_equal(Integer(tempnode),Integer(X)) then begin

      if M.get(Integer(tempnode),Integer(P)) then begin
        tempnodeX := PToken(P.x);
      end
      else begin
        tempnodeX := nil;
      end;

      if M.removeandget(Integer(W),Integer(P)) then
        dispose(P);
      if M.removeandget(Integer(X),Integer(P)) then
        dispose(P);
      if tempnodeX <> nil then begin
        if M.removeandget(Integer(tempnode),Integer(P)) then
          dispose(P);
        if M.removeandget(Integer(tempnodeX),Integer(P)) then
          dispose(P);
      end;

      new(P);
      P.x := Integer(X);
      P.y := 1;
      if not M.add(Integer(tempnode),Integer(P)) then begin
        dispose(P);
      end;
      new(P);
      P.x := Integer(tempnode);
      P.y := 2;
      if not M.add(Integer(X),Integer(P)) then begin
        dispose(P);
      end;
      if tempnodeX <> nil then begin
        new(P);
        P.x := Integer(tempnodeX);
        P.y := 1;
        if not M.add(Integer(W),Integer(P)) then begin
          dispose(P);
        end;
        new(P);
        P.x := Integer(W);
        P.y := 2;
        if not M.add(Integer(tempnodeX),Integer(P)) then begin
          dispose(P);
        end;
      end;
      break;

                  end;
                end
                else begin
                  if compfunc_intnode_equal(Integer(tempnode),Integer(X)) then begin

      if M.get(Integer(tempnode),Integer(P)) then begin
        tempnodeX := PToken(P.x);
      end
      else begin
        tempnodeX := nil;
      end;

      if M.removeandget(Integer(W),Integer(P)) then
        dispose(P);
      if M.removeandget(Integer(X),Integer(P)) then
        dispose(P);
      if tempnodeX <> nil then begin
        if M.removeandget(Integer(tempnode),Integer(P)) then
          dispose(P);
        if M.removeandget(Integer(tempnodeX),Integer(P)) then
          dispose(P);
      end;

      new(P);
      P.x := Integer(X);
      P.y := 1;
      if not M.add(Integer(tempnode),Integer(P)) then begin
        dispose(P);
      end;
      new(P);
      P.x := Integer(tempnode);
      P.y := 2;
      if not M.add(Integer(X),Integer(P)) then begin
        dispose(P);
      end;
      if tempnodeX <> nil then begin
        new(P);
        P.x := Integer(tempnodeX);
        P.y := 1;
        if not M.add(Integer(W),Integer(P)) then begin
          dispose(P);
        end;
        new(P);
        P.x := Integer(W);
        P.y := 2;
        if not M.add(Integer(tempnodeX),Integer(P)) then begin
          dispose(P);
        end;
      end;
      break;

                  end;
                end;
                tempnode := tempnode.sibling;
              end;
            end;
          end;

          X := X.sibling;
        end;

      end

    end;
    C.Free;
  end;

  function findpos(X: PToken): Integer;
  var Y,U,V,W,T: PToken;
      index,j,last: Integer;
  begin
    Y := X._parent;
//    Mnew.get(Integer(X),Integer(P));
//    W := PToken(P.x);

    T := Y.child;
    while T <> nil do begin
      if T._inorder > 0 then begin
        if T = X then begin
          result := 1;
          Exit;
        end
        else begin
          break;
        end;
      end;
      T := T.sibling;
    end;

(*    index := childpos(X);
    T := Y.child;
    V := nil;
    for j := 1 to Pred(index) do begin
      if T._inorder > 0 then begin
        last := j;
        V := T;
      end;
      T := T.sibling;
    end;*)

    V := nil;
    T := Y.child;
    while T <> X do begin
      if T._inorder > 0 then begin
        V := T;
      end;
      T := T.sibling;
    end;

    if V <> nil then begin
      if Mnew.get(Integer(V),Integer(P)) then begin
        U := PToken(P.x);
        result := childpos(U) + 1;   //nemal by to byt childpos iba tych ktore su inorder ?
      end
      else begin
        result := childpos(V) + 1;
      end;
    end
    else
      result := 0;  //error
  end;

  procedure alignChildren(W,X: PToken);
  var C,C1,C2,C1nm,C2nm: TQueueStack;
      T: PToken;
      P: PPair;
      U,V: PToken;
      i: Integer;
  begin
    C1 := TQueueStack.create;
    C2 := TQueueStack.create;
    //mark all children of w and x to not inorder (i.e. inorder = 0) - hmm really necessary ?
    //fill C1,C2 with those children of w resp. x, which match with the other ones
    T := W.child;
    while T <> nil do begin
      T._inorder := 0;
      if Mnew.get(Integer(T),Integer(P)) then begin
        if PToken(P.x)._parent = X then begin
          C1.push(Integer(T));
        end;
      end;
      T := T.sibling;
    end;

    T := X.child;
    while T <> nil do begin
      T._inorder := 0;
      if Mnew.get(Integer(T),Integer(P)) then begin
        if PToken(P.x)._parent = W then begin
          C2.push(Integer(T));
        end;
      end;
      T := T.sibling;
    end;

//    Mtemp := Mnew;
    C := getLCS(C1,C2,C1nm,C2nm,equalfunc);

    while not C.isEmpty do begin
      U := PToken(C.dequeue);
      V := PToken(C.dequeue);
      U._inorder := 1;
      V._inorder := 1;
    end;

    //for each not LCSed, but matched in C1,C2 do move => MOVE
    while not C1nm.isEmpty do begin
      Application.ProcessMessages;
      if FGlobalHalt then
        break;
      U := PToken(C1nm.dequeue);
      C2nm.peekNextReset;
      while C2nm.peekNext(Integer(V)) do begin
        if Mnew.get(Integer(U),Integer(P)) then begin
          if (PToken(P.x) = V) then begin
            C2nm.removeCurrentNode;  //!WARNING!
            k := findPos(V);

            //delete
(*            firstchild := U.child;
            if firstchild <> nil then begin
              tempNode := firstchild;
              while tempNode.sibling <> nil do begin
                tempNode := tempNode.sibling;
              end;
              lastchild := tempNode;
            end
            else begin
              lastchild := nil;
            end;
            tempnode := W.child;
            if tempnode = U then begin
              if firstchild = nil then begin
                W.child := U.sibling;
              end
              else begin
                W.child := firstchild;
                lastchild.sibling := U.sibling;
              end;
            end
            else begin
              while tempNode.sibling <> U do begin
                tempNode := tempNode.sibling;
              end;
              if firstchild = nil then begin
                tempNode.sibling := U.sibling;
              end
              else begin
                tempNode.sibling := firstchild;
                lastchild.sibling := U.sibling;
              end;
            end;*)
            tempnode := W.child;
            if tempnode = U then begin
              W.child := U.sibling;
            end
            else begin
              while tempnode <> nil do begin
                if tempnode.sibling = U then begin
                  tempnode.sibling := U.sibling;
                  break;
                end;
                tempnode := tempnode.sibling;
              end;
            end;

            if tempnode = nil then begin
{$IFDEF DEBUG1}
              writeln('FATAL in alignnodes!!!!!!!');
{$ENDIF}
            end
            else begin
              //insert
              tempnode := W.child;
              if k <= 1 then begin
                W.child := U;
                U.sibling := tempnode;
              end
              else begin
                for i := 1 to k-2 do begin
                  if tempNode.sibling = nil then
                    break;
                  tempnode := tempnode.sibling;
                end;
                U.sibling := tempnode.sibling;
                tempnode.sibling := U;
              end;
              //add to change script  !TODO! hmmm is this alright ?
              if ((V.child <> nil) or (V.value <> PToken(P.x).value) or (V.value <> PToken(P.x).value)) then begin
                ES.push(ES_MOVE);
                ES.push(U._id);
                ES.push(W._id);
                ES.push(k);
                cmove := cmove + 1;
              end;
            end;

            //set inorder flags
            U._inorder := 1;
            V._inorder := 1;
          end;
        end;
      end;
    end;

    C1nm.Free;
    C2nm.Free;
    C1.Free;
    C2.Free;
    C.Free;
  end;

  procedure postorderdeleteNodes(R: PToken);
  var tempNode,X: PToken;
      P: PPair;
  begin
    tempNode := R.child;
    if tempNode <> nil then begin
      X := tempNode.sibling;
      postorderdeleteNodes(tempNode);
      tempNode := X;
      while tempNode <> nil do begin
        X := tempNode.sibling;
        postorderdeleteNodes(tempNode);
        tempNode := X;
      end;
    end;

    if not Mnew.get(Integer(R),Integer(P)) then begin
      //delete from tree
      if R._parent = nil then begin
{$IFDEF DEBUG1}
          writeln('deleting root - not possible - add dummy root to both trees!');
{$ENDIF}
        Exit;
      end;
      firstchild := R.child;
      if firstchild <> nil then begin
        tempNode := firstchild;
        while tempNode.sibling <> nil do begin
          tempNode := tempNode.sibling;
        end;
        lastchild := tempNode;
      end
      else begin
        lastchild := nil;
      end;
      tempNode := R._parent.child;
      if tempNode = R then begin
        if firstchild = nil then begin
          R._parent.child := R.sibling;
        end
        else begin
          R._parent.child := firstchild;
          lastchild.sibling := R.sibling;
        end;
      end
      else begin
        while tempNode.sibling <> R do begin
          tempNode := tempNode.sibling;
        end;
        if firstchild = nil then begin
          tempNode.sibling := R.sibling;
        end
        else begin
          tempNode.sibling := firstchild;
          lastchild.sibling := R.sibling;
        end;
      end;
      //add to edit script
      ES.push(ES_DELETE);
      ES.push(R._id);
      cd := cd + 1;
      //dispose the tree token - hmm asi radsej nevymazavat !TODO!
      dispose(R);
    end;
  end;

  procedure writelnES;
  begin
    ES.peekNextReset;
    l := 0;
    while ES.peekNext(I) do begin
      l := l + 1;
      if I = ES_MOVE then begin
        ES.peekNext(x);
        ES.peekNext(y);
        ES.peekNext(k);
{$IFDEF DEBUG7}
        writeln('MOVE ' + IntToStr(x) + ' (' + IntToStr(y) + ',' + IntToStr(k) + ')');
        writeln(ia1[x].tokentype,';',ia1[x].startp,'_',ia1[x].endp,':::',ia1[y].tokentype,';',ia1[y].startp,'_',ia1[y].endp,' , ',k);
        writeln(ia1[x].value,':::',ia1[y].value);
{$ENDIF}
      end
      else if I = ES_INSERT then begin
        ES.peekNext(x);
        ES.peekNext(y);
        ES.peekNext(k);
{$IFDEF DEBUG7}
        writeln('INSERT ' + IntToStr(x) + ' (' + IntToStr(y) + ',' + IntToStr(k) + ')');
        writeln(ia2[x].tokentype,';',ia2[x].startp,'_',ia2[x].endp,'III',ia1[y].tokentype,';',ia1[y].startp,'_',ia1[y].endp,' , ',k);
        writeln(ia2[x].value,'III',ia1[y].value);
{$ENDIF}
      end
      else if I = ES_CHANGE then begin
        ES.peekNext(x);
        ES.peekNext(y);
{$IFDEF DEBUG7}
        writeln('CHANGE ' + IntToStr(x) + ' -> ' + IntToStr(y));
        writeln(ia1[x].tokentype,';',ia1[x].startp,'_',ia1[x].endp,'-->',ia2[y].tokentype,';',ia2[y].startp,'_',ia2[y].endp);
        writeln(ia1[x].value,'-->',ia2[y].value);
{$ENDIF}
      end
      else if I = ES_DELETE then begin
        ES.peekNext(x);
{$IFDEF DEBUG7}
        writeln('DELETE ' + IntToStr(x));
//        writeln(ia1[x].tokentype,';',ia1[x].startp,'_',ia1[x].endp,'DDD');
//        writeln(ia1[x].value);
{$ENDIF}
      end;
    end;
{$IFDEF DEBUG7}
    writeln('TOTAL NUMBER OF EDIT SCRIPT OPERATIONS: ' + IntToStr(l));
{$ENDIF}
    result.score := l;
  end;

var count: Integer;
    Q1lcs,Q2lcs: TQueueStack;
    bLeafRound: Boolean;
begin
  new(result);
  result.score := -1;
  ch := 0; cd := 0; ci := 0; cm := 0; cmove := 0;
  FileDiffForm.StatusBar1.Panels[4].Text := 'Calculating matching...';

  fast_match_time := getcurrenttime;
  //FASTMATCH START
//  M := TIntIntHashSet.create(true,mapping_hash,mapping_equal);
  M := TIntIntHashSet.create;
  Mtemp := M;

  fillInOrderArrays(root1,size1,root2,size2);
  root1._parent := nil;
  root2._parent := nil;
  Application.ProcessMessages;
  if FGlobalHalt then
    Exit;

{$IFDEF DEBUG2}
  for i := 0 to Pred(Length(ia1)) do begin
    writeln('#' + IntToStr(ia1[i].tokentype));
  end;
  for i := 0 to Pred(Length(ia2)) do begin
    writeln('%' + IntToStr(ia2[i].tokentype));
  end;
{$ENDIF}

  Q1 := TQueueStack.create;
  for i := 0 to Pred(size1) do begin
    if ia1[i].child = nil then
      Q1.push(Integer(ia1[i]));
  end;
  Q2 := TQueueStack.create;
  for i := 0 to Pred(size2) do begin
    if ia2[i].child = nil then
      Q2.push(Integer(ia2[i]));
  end;

  count := 0;
  bLeafRound := true;
  while (not Q1.isEmpty) and (not Q2.isEmpty) do begin
    chainsSet := TIntIntHashSet.create;
    chainsSet2 := TIntIntHashSet.create;
    leafslabelsSet := TIntHashSet.create;
//    intnodeslabelsSet := TIntHashSet.create;

    Q1.peekNextReset;
    while Q1.peekNext(Integer(nodeX)) do begin
      if chainsSet.get(nodeX.tokentype,Integer(Q)) then begin
      end
      else begin
        Q := TQueueStack.create;
        chainsSet.add(nodeX.tokentype,Integer(Q));
      end;
      Q.push(Integer(nodeX));
      leafslabelsSet.add(nodeX.tokentype);
    end;

    Q2.peekNextReset;
    while Q2.peekNext(Integer(nodeX)) do begin
      if chainsSet2.get(nodeX.tokentype,Integer(Q)) then begin
      end
      else begin
        Q := TQueueStack.create;
        chainsSet2.add(nodeX.tokentype,Integer(Q));
      end;
      Q.push(Integer(nodeX));
      leafslabelsSet.add(nodeX.tokentype);
    end;

  //  count := 0;
    leafslabelsSet.getNextReset;
    while leafslabelsSet.getNext(l) do begin
{$IFDEF DEBUG1}
      writeln(l);
{$ENDIF}
      if (count and CYCLE_THRESHOLD = 0) then begin
        Application.ProcessMessages;
      end;
      if FGlobalHalt then
        break;
      if not chainsSet.get(l,Integer(Q1lcs)) then
        Q1lcs := nil;
      if not chainsSet2.get(l,Integer(Q2lcs)) then
        Q2lcs := nil;
      if bLeafRound then
        Q := getLCS(Q1lcs,Q2lcs,Q1u,Q2u,compfunc_leaf_equal)
      else
        Q := getLCS(Q1lcs,Q2lcs,Q1u,Q2u,compfunc_intnode_equal);

      while not Q.isEmpty do begin
        x := Q.dequeue;
        y := Q.dequeue;
        new(P);
        P.x := y;
        P.y := 1;
        if not M.add(x,Integer(P)) then begin
          dispose(P);
        end
        else begin
          if bLeafRound then begin
            PToken(x)._hash := 1;
            PToken(y)._hash := 1;
          end;
        end;
        new(P);
        P.x := x;
        P.y := 2;
        if not M.add(y,Integer(P)) then begin
          dispose(P);
        end;
      end;

      while not Q1u.isEmpty do begin
        x := Q1u.dequeue;
        Q2u.peekNextReset;
        while Q2u.peekNext(y) do begin
          if bLeafRound then
            b := compfunc_leaf_equal(x,y)
          else
            b := compfunc_intnode_equal(x,y);
          if b then begin
            Q2u.removeCurrentNode;
            new(P);
            P.x := y;
            P.y := 1;
            if not M.add(x,Integer(P)) then begin
              dispose(P);
            end
            else begin
              if bLeafRound then begin
                PToken(x)._hash := 1;
                PToken(y)._hash := 1;
              end;
            end;
            new(P);
            P.x := x;
            P.y := 2;
            if not M.add(y,Integer(P)) then begin
              dispose(P);
            end;
            break;
          end;
        end;
      end;

      Q1u.Free;
      Q2u.Free;
      Q.Free;

      count := count + 1;
    end;

    Q := TQueueStack.create;
    Q1.peekNextReset;
    while Q1.peekNext(Integer(nodeX)) do begin
      if (nodeX._parent <> nil) and (Q.top <> Integer(nodeX._parent)) then begin
        nodeX._parent._hash := nodeX._hash;
        Q.push(Integer(nodeX._parent));
      end
      else if (nodeX._parent <> nil) then begin
        nodeX._parent._hash := nodeX._parent._hash + nodeX._hash;
      end;
    end;
    Q1.Free;
    Q1 := Q;

    Q := TQueueStack.create;
    Q2.peekNextReset;
    while Q2.peekNext(Integer(nodeX)) do begin
      if (nodeX._parent <> nil) and (Q.top <> Integer(nodeX._parent)) then begin
        nodeX._parent._hash := nodeX._hash;
        Q.push(Integer(nodeX._parent));
      end
      else if (nodeX._parent <> nil) then begin
        nodeX._parent._hash := nodeX._parent._hash + nodeX._hash;
      end;
    end;
    Q2.Free;
    Q2 := Q;

    bLeafRound := false;

    leafslabelsSet.Free;
//    intnodeslabelsSet.Free;
    chainsSet.getNextReset;
    while chainsSet.getNext(i,Integer(Q)) do begin
      Q.Free;
    end;
    chainsSet.Free;
    chainsSet2.getNextReset;
    while chainsSet2.getNext(i,Integer(Q)) do begin
      Q.Free;
    end;
    chainsSet2.Free;

    count := count + 1;
  end;

  Q1.Free;
  Q2.Free;
(*
  for i := 0 to Pred(size1) do begin
    if (i and CYCLE_THRESHOLD = 0) then begin
      Application.ProcessMessages;
    end;
    if FGlobalHalt then
      break;
    if chainsSet.get(ia1[i].tokentype,Integer(Q)) then begin
    end
    else begin
      Q := TQueueStack.create;
      chainsSet.add(ia1[i].tokentype,Integer(Q));
    end;
    Q.push(Integer(ia1[i]));
    if ia1[i].child = nil then
      leafslabelsSet.add(ia1[i].tokentype)
    else
      intnodeslabelsSet.add(ia1[i].tokentype);
  end;
  for i := 0 to Pred(size2) do begin
    if (i and CYCLE_THRESHOLD = 0) then begin
      Application.ProcessMessages;
    end;
    if FGlobalHalt then
      break;
    if chainsSet2.get(ia2[i].tokentype,Integer(Q)) then begin
    end
    else begin
      Q := TQueueStack.create;
      chainsSet2.add(ia2[i].tokentype,Integer(Q));
    end;
    Q.push(Integer(ia2[i]));
    if ia2[i].child = nil then
      leafslabelsSet.add(ia2[i].tokentype)
    else
      intnodeslabelsSet.add(ia2[i].tokentype);
  end;

  FileDiffForm.StatusBar1.Panels[4].Text := 'Calculating leafs matching...';
  count := 0;
  leafslabelsSet.getNextReset;
  while leafslabelsSet.getNext(l) do begin
{$IFDEF DEBUG1}
    writeln(l);
{$ENDIF}
    if (count and CYCLE_THRESHOLD = 0) then begin
      Application.ProcessMessages;
    end;
    if FGlobalHalt then
      break;
    if not chainsSet.get(l,Integer(Q1)) then
      Q1 := nil;
    if not chainsSet2.get(l,Integer(Q2)) then
      Q2 := nil;
    Q := getLCS(Q1,Q2,Q1u,Q2u,compfunc_leaf_equal);

    while not Q.isEmpty do begin
      x := Q.dequeue;
      y := Q.dequeue;
      new(P);
      P.x := y;
      P.y := 1;
      if not M.add(x,Integer(P)) then begin
        dispose(P);
      end;
      new(P);
      P.x := x;
      P.y := 2;
      if not M.add(y,Integer(P)) then begin
        dispose(P);
      end;
    end;

    while not Q1u.isEmpty do begin
      x := Q1u.dequeue;
      Q2u.peekNextReset;
      while Q2u.peekNext(y) do begin
        if compfunc_leaf_equal(x,y) then begin
          Q2u.removeCurrentNode;
          new(P);
          P.x := y;
          P.y := 1;
          if not M.add(x,Integer(P)) then begin
            dispose(P);
          end;
          new(P);
          P.x := x;
          P.y := 2;
          if not M.add(y,Integer(P)) then begin
            dispose(P);
          end;
          break;
        end;
      end;
    end;

    Q1u.Free;
    Q2u.Free;
    Q.Free;

    count := count + 1;
  end;

  FileDiffForm.StatusBar1.Panels[4].Text := 'Calculating internal nodes matching...';
  count := 0;
  intnodeslabelsSet.getNextReset;
  while intnodeslabelsSet.getNext(l) do begin
{$IFDEF DEBUG1}
    writeln(l);
{$ENDIF}
    if (count and CYCLE_THRESHOLD = 0) then begin
      Application.ProcessMessages;
    end;
    if FGlobalHalt then
      break;
    if not chainsSet.get(l,Integer(Q1)) then
      Q1 := nil;
    if not chainsSet2.get(l,Integer(Q2)) then
      Q2 := nil;
    Q := getLCS(Q1,Q2,Q1u,Q2u,compfunc_intnode_equal);

    while not Q.isEmpty do begin
      x := Q.dequeue;
      y := Q.dequeue;
      new(P);
      P.x := y;
      P.y := 1;
      if not M.add(x,Integer(P)) then begin
        dispose(P);
      end;
      new(P);
      P.x := x;
      P.y := 2;
      if not M.add(y,Integer(P)) then begin
        dispose(P);
      end;
    end;

    while not Q1u.isEmpty do begin
      x := Q1u.dequeue;
      Q2u.peekNextReset;
      while Q2u.peekNext(y) do begin
        if compfunc_intnode_equal(x,y) then begin
          Q2u.removeCurrentNode;
          new(P);
          P.x := y;
          P.y := 1;
          if not M.add(x,Integer(P)) then begin
            dispose(P);
          end;
          new(P);
          P.x := x;
          P.y := 2;
          if not M.add(y,Integer(P)) then begin
            dispose(P);
          end;
          break;
        end;
      end;
    end;

    Q1u.Free;
    Q2u.Free;
    Q.Free;
    count := count + 1;
  end;
*)
  if not FGlobalHalt then
    correctfastmatch;
  //FASTMATCH END
  fast_match_time := getcurrenttime - fast_match_time;

{$IFDEF DEBUG1}
  M.getNextReset;
  l := 0;
  while M.getNext(i,Integer(P)) do begin
    l := l + 1;
    if P.y = 1 then begin
      if PToken(i).value <> PToken(P.x).value then
        write('!!!!!!!');
      writeln(l,' ::: ',i,': ',PToken(i).tokentype,' = ',PToken(i).value,';',ia1[PToken(i)._id].startp,'_',ia1[PToken(i)._id].endp,' ---- ',P.x,': ',PToken(P.x).tokentype,' = ',PToken(P.x).value,';',ia2[PToken(P.x)._id].startp,'_',ia2[PToken(P.x)._id].endp,'[',P.y,']');
      i := P.x;
      M.get(i,Integer(P2));
      writeln(l,' ::: ',i,': ',PToken(i).tokentype,' = ',PToken(i).value,';',ia2[PToken(i)._id].startp,'_',ia2[PToken(i)._id].endp,' ---- ',P2.x,': ',PToken(P2.x).tokentype,' = ',PToken(P2.x).value,';',ia1[PToken(P2.x)._id].startp,'_',ia1[PToken(P2.x)._id].endp,'[',P2.y,']');
(*    end
    else begin
      if PToken(i).value <> PToken(P.x).value then
        write('!!!!!!!');
      writeln(l,' ::: ',i,': ',PToken(i).tokentype,' = ',PToken(i).value,';',ia2[PToken(i)._id].startp,'_',ia2[PToken(i)._id].endp,' ---- ',P.x,': ',PToken(P.x).tokentype,' = ',PToken(P.x).value,';',ia1[PToken(P.x)._id].startp,'_',ia1[PToken(P.x)._id].endp,'[',P.y,']');
*)    end;
  end;
{$ENDIF}

  //!TODO! inorder ---> 0

  FileDiffForm.StatusBar1.Panels[4].Text := 'Building edit script...';
  edit_script_time := getcurrenttime;

  //EDITSCRIPT START

  size1new := size1;
  ES := TQueueStack.create;
//  Mnew := M.clone;  //!WARNING! shared PPairs between M and Mnew!!
  Mnew := M;
  Mtemp := Mnew;

  Q := TQueueStack.create;

  Q.push(Integer(root2));
  bCycle := false;
  while not Q.isEmpty do begin
    Application.ProcessMessages;
    if FGlobalHalt then
      break;
    if not bCycle then begin
      nodeX := PToken(Q.dequeue);
      tempnode := nodeX.child;
      while tempnode <> nil do begin
        Q.push(Integer(tempnode));
        tempnode := tempnode.sibling;
      end;
    end
    else begin
      bCycle := false;
    end;

    if Mnew.get(Integer(nodeX),Integer(P)) then
      nodeW := PToken(P.x)
    else
      nodeW := nil;

    nodeY := nodeX._parent;

    if nodeY <> nil then begin
      Mnew.get(Integer(nodeY),Integer(P));
      nodeZ := PToken(P.x);
      if nodeZ = nil then begin
{$IFDEF DEBUG1}
        writeln('FATAL!!!!!!!!!!!!!!!!! Y <> nil /\ Z = nil ---- !!! ????');
{$ENDIF}
      end;
    end
    else begin
      if nodeW = nil then begin
{$IFDEF DEBUG1}
        writeln('FATAL!!!!!!!!!!!!!!!!! rooty nematchuju ---- !!! ????');
{$ENDIF}
        nodeW := root1;
        new(P);
        P.x := Integer(nodeX);
        P.y := 1;
        Mnew.add(Integer(nodeW),Integer(P));
        new(P);
        P.x := Integer(nodeW);
        P.y := 2;
        Mnew.add(Integer(nodeX),Integer(P));
      end;
      nodeZ := nil;
    end;

    if nodeW = nil then begin  //nodeX has no partner in Mnew mapping => INSERT
      k := findPos(nodeX);
      //generate new node
      new(nodeW);
      nodeW^ := nodeX^;
      nodeW.child := nil;
      nodeW.sibling := nil; //set later - see bellow
      nodeW._parent := nodeZ;
      nodeW._inorder := 1;
      nodeW._id := size1new;
      size1new := size1new + 1;
//      writeln('True Tree1 Size: ' + IntToStr(size1new));
      //add to mapping
      new(P);
      P.x := Integer(nodeX);
      P.y := 3;
      Mnew.add(Integer(nodeW),Integer(P));
      new(P);
      P.x := Integer(nodeW);
      P.y := 4;
      Mnew.add(Integer(nodeX),Integer(P));
      //add to tree
      tempnode := nodeZ.child;
      if k <= 1 then begin
        nodeZ.child := nodeW;
        nodeW.sibling := tempnode;
      end
      else begin
        for i := 1 to k-2 do begin
          if tempNode.sibling = nil then
            break;
          tempnode := tempnode.sibling;
        end;
        nodeW.sibling := tempnode.sibling;
        tempnode.sibling := nodeW;
      end;
      //add to change script
      ES.push(ES_INSERT);
      ES.push(nodeX._id);
      ES.push(nodeZ._id);
      ES.push(k);
      ci := ci + 1;
      //set inorder flags
      nodeW._inorder := 1;
      nodeX._inorder := 1;
      //add to inorder array !TODO! remove!
      if size1new >= Length(ia1) then begin
        SetLength(ia1,size1new shl 1 + 2);
      end;
      nodeW._id := size1new;
      ia1[nodeW._id] := nodeW;
//      SetLength(ia1,Length(ia1) + 1);
//      nodeW._id := Pred(Length(ia1));
//      ia1[nodeW._id] := nodeW;
    end
    else if nodeX <> root2 then begin  //nodeX has partner nodeW, in Mnew mapping
      nodeV := nodeW._parent;
      if nodeW.value <> nodeX.value then begin  // => UPDATE
        //update tree
        nodeW.value := nodeX.value;
        //add to change script
        ES.push(ES_CHANGE);
        ES.push(nodeW._id);
        ES.push(nodeX._id);
        ch := ch + 1;
      end
      else begin  // => MATCH
        cm := cm + 1;
      end;
//      Mnew.get(Integer(nodeY),Integer(P));
      if nodeZ <> nodeV then begin        // => MOVE
        k := findPos(nodeX);
        //check if nodeZ is not descendant of nodeW, if so moving is forbidden! (and matching will be removed and nodeX will be considered again)
        //bCycle := false;
        tempnode := nodeZ._parent;
        while tempnode <> nil do begin
          if tempnode = nodeW then begin
            bCycle := true;
            if Mnew.removeandget(Integer(nodeW),Integer(P)) then
              dispose(P);
//            else
//              writeln('problem');
            if Mnew.removeandget(Integer(nodeX),Integer(P)) then
              dispose(P);
//            else
//              writeln('problem');
{$IFDEF DEBUG1}
            writeln('REMOVED CYCLE!!!!!!!!!!');
{$ENDIF}
            break;
          end;
          tempnode := tempnode._parent;
        end;
        if not bCycle then begin
          //move into tree (w at pos q, shifts q..child[n] to the right
          //delete
//          i := subtreesize(nodeW);
//          writeln('nodeW: ' + IntToStr(i));
          tempnode := nodeV.child;
          if tempnode = nodeW then begin
            nodeV.child := nodeW.sibling;
          end
          else begin
            while tempnode <> nil do begin
              if tempnode.sibling = nodeW then begin
                tempnode.sibling := nodeW.sibling;
                break;
              end;
              tempnode := tempnode.sibling;
            end;
          end;
(*          firstchild := nodeW.child;
          if firstchild <> nil then begin
            tempNode := firstchild;
            while tempNode.sibling <> nil do begin
              tempNode := tempNode.sibling;
            end;
            lastchild := tempNode;
          end
          else begin
            lastchild := nil;
          end;
          tempnode := nodeV.child;
          if tempnode = nodeW then begin
            if firstchild = nil then begin
              nodeV.child := nodeW.sibling;
            end
            else begin
              nodeV.child := firstchild;
              lastchild.sibling := nodeW.sibling;
            end;
          end
          else begin
            while tempNode.sibling <> nodeW do begin
              tempNode := tempNode.sibling;
            end;
            if firstchild = nil then begin
              tempNode.sibling := nodeW.sibling;
            end
            else begin
              tempNode.sibling := firstchild;
              lastchild.sibling := nodeW.sibling;
            end;
          end;*)
          if tempnode = nil then begin
{$IFDEF DEBUG1}
            writeln('FATAL W in not a child of V, but X is a child of Y and M(X,W) and M(Y,Z) => bad matching!!!');
{$ENDIF}
          end
          else begin
            //insert
            tempnode := nodeZ.child;
            if k <= 1 then begin
              nodeZ.child := nodeW;
              nodeW.sibling := tempnode;
            end
            else begin
              for i := 1 to k-2 do begin
                if tempNode.sibling = nil then
                  break;
                tempnode := tempnode.sibling;
              end;
              nodeW.sibling := tempnode.sibling;
              tempnode.sibling := nodeW;
            end;
            nodeW._parent := nodeZ;
//            i := subtreesize(nodeW);
//            writeln('nodeW: ' + IntToStr(i));
//            i := subtreesize(nodeZ);
//            writeln('nodeZ: ' + IntToStr(i));
            //add to change script
            ES.push(ES_MOVE);
            ES.push(nodeW._id);
            ES.push(nodeZ._id);
            ES.push(k);
            cmove := cmove + 1;
            //set inorder flags
            nodeW._inorder := 1;
            nodeX._inorder := 1;
          end;
        end;
      end;
    end;
{$IFDEF DEBUG2}
    writeln('BEFORE ALIGNCHILDREN');
    writeln('BEFORE ALIGNCHILDREN');
    writeln('BEFORE ALIGNCHILDREN');
    writeln('BEFORE ALIGNCHILDREN');
    writeln('BEFORE ALIGNCHILDREN');
    writelnES;
{$ENDIF}
{$IFDEF DEBUG2}
    i := subtreesize(root1);
    writeln('TREE1: ' + IntToStr(i));
    writeln('MEMORY: ' + IntToStr(fp.getmemcount - fp.freememcount));
{$ENDIF}
    if not bCycle then
      alignChildren(nodeW,nodeX);
{$IFDEF DEBUG2}
//    if i = 51 then break;
    i := subtreesize(root1);
{$ENDIF}
{$IFDEF DEBUG2}
    writeln('AFTER ALIGNCHILDREN');
    writeln('AFTER ALIGNCHILDREN');
    writeln('AFTER ALIGNCHILDREN');
    writeln('AFTER ALIGNCHILDREN');
    writeln('AFTER ALIGNCHILDREN');
    writelnES;
{$ENDIF}
  end;

  if not FGlobalHalt then
    postorderdeleteNodes(root1);

  //EDITSCRIPT END

  Q.Free;
//  Mnew.Free;
  writelnES;

  ES.Free;

  //ABSOLUTE END

//  M.Free;

{$IFDEF DEBUG1}
  writeln('-------------------------------------------------');
  writeln('-------------------------------------------------');
  writeln('-------------------------------------------------');

  Mnew.getNextReset;
  l := 0;
  while Mnew.getNext(i,Integer(P)) do begin
    l := l + 1;
//    if P.y = 1 then begin
      if PToken(i).value <> PToken(P.x).value then
        write('!!!!!!!');
      writeln(l,' : ',PToken(i).tokentype,' = ',PToken(i).value,' -- ',PToken(P.x).tokentype,' = ',PToken(P.x).value,'[',P.y,']');
//    end;
    dispose(P);
  end;
  Mnew.Free;
{$ELSE}
  Mnew.getNextReset;
  while Mnew.getNext(i,Integer(P)) do begin
    dispose(P);
  end;
  Mnew.Free;
{$ENDIF}
  ia1 := nil;
  ia2 := nil;

  edit_script_time := getcurrenttime - edit_script_time;
{$IFDEF DEBUG0}
  writeln('Fast Match time: ' + IntToStr(fast_match_time));
  writeln('Edit Script Build time: ' + IntToStr(edit_script_time));
  writeln('Total treediff time: ' + IntToStr(fast_match_time + edit_script_time));
{$ENDIF}
{$IFDEF LOG0}
  LogForm.AddLine('Fast Match time: ' + IntToStr(fast_match_time));
  LogForm.AddLine('Edit Script Build time: ' + IntToStr(edit_script_time));
  LogForm.AddLine('Total treediff time: ' + IntToStr(fast_match_time + edit_script_time));
{$ENDIF}

  result.nc := ch;
  result.nd := cd;
  result.ni := ci;
  result.nm := cm;
  result.nmove := cmove;
end;

end.
