Const MaxM              = 5000;

Var   Q                 : Array[1..MaxM,1..2] of Longint;
      C                 : Array[1..MaxM] of Byte;

      O                 : Array[1..2,0..MaxM] of Integer;
      T                 : Integer;

      N                 : Longint;
      M                 : Integer;

Procedure DelL(X        : Integer);
Var i                   : Integer;
Begin
  For i := 1 to T do
    If Q[O[1,i],1]>Q[X,1] then Break else
      If Q[O[1,i],1]=Q[X,1] then
        If Q[O[1,i],2]<=Q[X,2] then
          Begin
            Q[X,1] := Q[O[1,i],2]+1;
            C[X] := C[X] xor C[O[1,i]];
            If Q[X,1]>Q[X,2] then Break;
          End;
End;

Procedure DelR(X        : Integer);
Var i                   : Integer;
Begin
  For i := T downto 1 do
    If Q[O[2,i],2]<Q[X,2] then Break else
      If Q[O[2,i],2]=Q[X,2] then
        If Q[O[2,i],1]>=Q[X,1] then
          Begin
            Q[X,2] := Q[O[2,i],1]-1;
            C[X] := C[X] xor C[O[2,i]];
            If Q[X,1]>Q[X,2] then Break;
          End;
End;

Function DeleteL(X : Integer) : Integer;
Var Temp           : Integer;
    i              : Integer;
Begin
  For i := 1 to T do
    If Q[X,1]=Q[O[1,i],1] then
      If Q[X,2]<Q[O[1,i],2] then
        Begin
          Q[O[1,i],1] := Q[X,2]+1;
          C[O[1,i]] := C[X] xor C[O[1,i]];
          Temp := X; X := O[1,i]; O[1,i] := Temp;
        End else
        Begin
          Q[X,1] := Q[O[1,i],2]+1;
          C[X] := C[X] xor C[O[1,i]];
       End;
  DeleteL := X;
End;

Function  DeleteR(X : Integer) : Integer;
Var Temp            : Integer;
    i               : Integer;
Begin
  For i := T downto 1 do
    If Q[X,2]=Q[O[2,i],2] then
      If Q[X,1]>Q[O[2,i],1] then
        Begin
          Q[O[2,i],2] := Q[X,1]-1;
          C[O[2,i]] := C[X] xor C[O[2,i]];
          Temp := X; X := O[2,i]; O[2,i] := Temp;
        End else
        Begin
          Q[X,2] := Q[O[2,i],1]-1;
          C[X] := C[X] xor C[O[2,i]];
       End;
  DeleteR := X;
End;

Function Pass(X         : Integer) : Boolean;
Var TempL,TempR         : Integer;
    i,j,k               : Integer;
Begin
  DelL(X);
  If Q[X,1]<=Q[X,2] then
    DelR(X);
  Pass := (Q[X,1]<=Q[X,2]) or (C[X]=0);
  If Q[X,1]<=Q[X,2] then
    Begin
      TempL := DeleteL(X);
      TempR := DeleteR(X);
    End else Exit;
  i := 1; j := T;
  If T=0 then j := 1 else
    If (Q[O[1,1],1]<Q[TempL,1]) and (Q[TempL,1]<Q[O[1,T],1]) then
      Begin
        Repeat
          k := (i+j) div 2;
          If Q[O[1,k],1]<Q[TempL,1] then j := k
                                    else i := k;
        Until j-i<2;
      End else
      Begin
        If Q[O[1,T],1]>Q[TempL,1] then j := 1
                                  else j := T+1;
      End;
  For i := j+1 to T+1 do
    O[1,i] := O[1,i-1];
  O[1,j] := TempL;

  i := 1; j := T;
  If T=0 then j := 1 else
    If (Q[O[2,1],2]<Q[TempR,2]) and (Q[TempR,2]<Q[O[2,T],2]) then
      Begin
        Repeat
          k := (i+j) div 2;
          If Q[O[2,k],2]<Q[TempR,2] then j := k
                                    else i := k;
        Until j-i<2;
      End else
      Begin
        If Q[O[2,T],2]>Q[TempR,2] then j := 1
                                  else j := T+1;
      End;
  For i := j+1 to T+1 do
    O[2,i] := O[2,i-1];
  O[2,j] := TempR;
  Inc(T);
End;

Procedure Main;
Var   i,j       : Integer;
      Str       : String;
      PrEnd     : Boolean;
Begin
  Repeat
    Readln(N);
    If N<>-1 then
      Begin
        Readln(M);
        PrEnd := True; T := 0;
        Fillchar(Q,Sizeof(Q),0);
        Fillchar(O,Sizeof(O),0);
        Fillchar(C,Sizeof(C),0);
        For i := 1 to M do
          Begin
            Readln(Q[i,1],Q[i,2],Str);
            C

I also got Memory Limit Exceeded. But I changed statical
varible allocation into dynamic and got AC.

Use like this
type
    SomeArray = array[1..MaxM] of LongInt;
var
    UsingArray: ^SomeArray;

begin
    New(UsingArray);
    .. Code ..
    Dispose(UsingArray);
end.

Every usage of array is like this
    UsingArray^[1000] := Random(100);

But do not forget, that this array is not filled by 0-th, so
you have to zero it up by yourself...

Good Luck !!!