Why do I get Memory Limit Exceeded?

Var
   ch: char;
   i,n: byte;
   tot: array [1..10] of word;
   d: array [1..10,1..1000] of char;

Procedure escribe(n: byte);
          var i: word;
          begin
          i:= 1;
          While (i <= tot[n]) do
                begin
                if d[n,i]= '*' then begin
                                       Inc(i);
                                       escribe (ord(d[n,i])-48)
                                       end
                                  else write(output,d[n,i]);
                Inc(i);
                end;
          end;

Begin
     readln(input,n);
     for i:= 1 to n do
         begin
         read(input,ch); tot[i]:= 0;
         while (ch<>'#') do
               begin
               Inc(tot[i]);
               d[i,tot[i]]:= ch;
               read(input,ch);
               end;
         readln(input);
         end;
     escribe(1);
End.

There can be next
2
Some strange text*2#
Another text *1#

You must check wether output is no longer than 1000000. It could grow
so big without loops!!!

10
*2*2*2*2*2*2*2*2*2*2 Tra-la-la#
*3*3*3*3*3*3*3*3*3*3 Tra-la-la#
...
*9*9*9*9*9*9*9*9*9*9 Tra-la-la#
Weird!!!#

Replace Tra-la-la with something longer.