Mine

var x:Array[1..100] of Integer;
   k,i:Integer;
   n:Integer;

 procedure kiir;
 var i:Integer;
 begin
  for i:=1 to n do Write(x[i]);
  WriteLn;
 end;

begin
ReadLn(n);

k:=1;

x[k]:=-1;

repeat;
while x[k]<1 do 
begin
 inc(x[k]);
 if k=n then kiir
  else 
   begin
    inc(k);
    x[k]:=-1;
   end;
end;
 
dec(k);
 
until k=0;
 
end.