Скажите где ошибка в программе

[Fireblade-fan]

Нужно написать задачку, тема написана что стеки. Я вроде написал, но программа не хочет работать. Взгляние одним глазком, подскажите что не так.
Условие прикрепил в картинке, номер 28. Заранее спасибо!

program Project3;
{$APPTYPE CONSOLE}
uses
  SysUtils;
const n=2;
Type chislo=packed array [1..n] of 0..9;
  stack=^Node;
  Node=Record
    info:chislo;
    next:stack
  End;
var top,L:stack; ch:chislo;
Procedure InStack(L:stack; x:chislo);
var q:stack;
begin {InStack}
  new(q);
  q^.info:=x;
  q^.next:=top;
  top:=q
end; {InStack}
Procedure PopStack(var L:stack; var ch:chislo);
var q:stack;
begin {PopStack}
  ch:=top^.info;
  q:=top;
  top:=top^.next;
  dispose(q)
end; {PopStack}
Procedure InitStack(var L:stack);
begin
  top:=nil
end;
procedure Print(stek1:stack);
var i:integer;
begin
  while stek1<>nil do {пока указатель stek1 не станет указывать в пустоту}
  begin   {а это произойдёт как только он перейдёт по ссылке последнего элемента}
    for i:=1 to n do
    Write(stek1^.info[i]); {выводить данне}
    write('  ');
    stek1:=stek1^.next  {и переносить указатель вглубь по стеку}
  end;
end;
Function EmptyStack(L:stack):boolean;
begin
  EmptyStack:=top=nil;
end;
Procedure upor(var L:stack);
var i,j,k:integer; ch:chislo;
  a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,L1:stack;
begin {upor}
  InitStack(L);
  writeln('skolko chisel?');
  readln(k);
  writeln('vvedite po cifre vse chisla');
  for i := 1 to k do
    begin
      for  j:=1 to n do
      begin
        read(ch[j]);
        InStack(L,ch)
      end;
    end;
  Print(L);
  InitStack(a0);
  InitStack(a1);
  InitStack(a2);
  InitStack(a3);
  InitStack(a4);
  InitStack(a5);
  InitStack(a6);
  InitStack(a7);
  InitStack(a8);
  InitStack(a9);
  InitStack(L1);
  while not EmptyStack(L) do
  begin
    PopStack(L,ch);
    for i := n downto 1  do
      case ch[i] of
      0:begin
          InStack(a0,ch);
          a0^.next:=a1;
        end;
      1:begin
          InStack(a1,ch);
          a1^.next:=a2;
        end;
      2:begin
          InStack(a2,ch);
          a2^.next:=a3;
        end;
      3:begin
          InStack(a3,ch);
          a3^.next:=a4;
        end;
      4:begin
          InStack(a4,ch);
          a4^.next:=a5;
        end;
      5:begin
          InStack(a5,ch);
          a5^.next:=a6;
        end;
      6:begin
          InStack(a6,ch);
          a6^.next:=a7;
        end;
      7:begin
          InStack(a7,ch);
          a7^.next:=a8;
        end;
      8:begin
          InStack(a8,ch);
          a8^.next:=a9;
        end;
      9:InStack(a9,ch);
      end;
       L^.next:=a0;
  end;
  Print(L)
end;  {upor}
begin
Upor(L);
readln
end.

[Fireblade-fan]

^^^_____^^^

[Fireblade-fan]

................

[Son Of Pain]

for  j:=1 to n do
begin
read(ch[j]);
InStack(L,ch)
end;

Что этот цикл помещает в стек, как ты думаешь? )

[Fireblade-fan]

Исправил некоторые ошибки, но программа просто выводит числа в обратном порядке (

program Project3;
{$APPTYPE CONSOLE}
uses
  SysUtils;
const n=2;
Type chislo=packed array [1..n] of 0..9;
  stack=^Node;
  Node=Record
    info:chislo;
    next:stack
  End;
var top,L:stack; ch:chislo; x:integer;
Procedure InStack(var L:stack; var x:chislo);
var q:stack;
begin {InStack}
  new(q);
  q^.info:=x;
  q^.next:=L;
  L:=q
end; {InStack}
Procedure PopStack(var L:stack; var ch:chislo);
var q:stack;
begin {PopStack}
  ch:=top^.info;
  q:=L;
  L:=q^.next;
  dispose(q)
end; {PopStack}
Procedure InitStack(var L:stack);
begin
  top:=nil
end;
procedure Print(var stek1:stack);
var i:integer;
begin
  while stek1<>nil do {пока указатель stek1 не станет указывать в пустоту}
  begin   {а это произойдёт как только он перейдёт по ссылке последнего элемента}
    for i:=1 to n do
    Write(stek1^.info[i]); {выводить данне}
    write('  ');
    stek1:=stek1^.next  {и переносить указатель вглубь по стеку}
  end;
end;
Function EmptyStack(L:stack):boolean;
begin
  EmptyStack:=top=nil;
end;
Procedure upor(var L:stack);
var i,j,k:integer; ch:chislo;
  a0,a1,a2,a3,a4,a5,a6,a7,a8,a9:stack;
begin {upor}
  InitStack(L);
  writeln('skolko chisel?');
  readln(k);
  writeln('vvedite po cifre vse chisla');
  for i := 1 to k do
  begin
    for  j:=1 to n do
        read(ch[j]);
    InStack(L,ch);
  end;
  InitStack(a0);
  InitStack(a1);
  InitStack(a2);
  InitStack(a3);
  InitStack(a4);
  InitStack(a5);
  InitStack(a6);
  InitStack(a7);
  InitStack(a8);
  InitStack(a9);
  while not EmptyStack(L) do
  begin
    PopStack(L,ch);
    for i := n downto 1  do
      case ch[i] of
      0:begin
          InStack(a0,ch);
          a0^.next:=a1;
        end;
      1:begin
          InStack(a1,ch);
          a1^.next:=a2;
        end;
      2:begin
          InStack(a2,ch);
          a2^.next:=a3;
        end;
      3:begin
          InStack(a3,ch);
          a3^.next:=a4;
        end;
      4:begin
          InStack(a4,ch);
          a4^.next:=a5;
        end;
      5:begin
          InStack(a5,ch);
          a5^.next:=a6;
        end;
      6:begin
          InStack(a6,ch);
          a6^.next:=a7;
        end;
      7:begin
          InStack(a7,ch);
          a7^.next:=a8;
        end;
      8:begin
          InStack(a8,ch);
          a8^.next:=a9;
        end;
      9:InStack(a9,ch);
    end;
    L:=a0;
  end;
  Print(L)
end;  {upor}
begin
  Upor(L);
  print(L);
  readln;
  readln(x)
end.

[Zer0]

Это и есть главное отличие стека от очереди, он ДОЛЖЕН выдавать в обратном порядке

[Fireblade-fan]

Блин, я совсем запутался.... в условии сказано что надо упорядочить по неубыванию. Вроде все сделал по предложенному алгоритму, а выводится просто в обратном порядке... (

[Fireblade-fan]

Не хочет сортировать, просто выводит в обратном порядке (

[Fireblade-fan]

кто нибудь скомпилируйте это и подскажите где я ошибся

program Project3;
{$APPTYPE CONSOLE}
const n=2;
Type chislo= array [1..n] of 0..9;
  stack=^Node;
  Node=Record
    info:chislo;
    next:stack
  End;
var top,L:stack; ch:chislo; x:integer;
Procedure InStack(var L:stack; var x:chislo);
var q:stack;
begin {InStack}
  new(q);
  q^.info:=x;
  q^.next:=L;
  L:=q
end; {InStack}
Procedure PopStack(var L:stack; var ch:chislo);
var q:stack;
begin {PopStack}
  ch:=L^.info;
  q:=L;
  L:=q^.next;
  dispose(q)
end; {PopStack}
Procedure InitStack(var L:stack);
begin
  top:=nil
end;
procedure Print(stek1:stack);
var i:integer;
begin
  while stek1<>nil do {???? ????????? stek1 ?? ?????? ????????? ? ???????}
  begin   {? ??? ?????????? ??? ?????? ?? ???????? ?? ?????? ?????????? ????????}
    for i:=1 to n do
    Write(stek1^.info[i]); {???????? ?????}
    write('  ');
    stek1:=stek1^.next  {? ?????????? ????????? ?????? ?? ?????}
  end;
end;
Function EmptyStack(L:stack):boolean;
begin
  EmptyStack:=L=nil;
end;
Procedure upor(var L:stack);
var i,j,y:integer; ch:chislo; b,k:0..9;
  a: array [0..9]of stack;
begin {upor}
  InitStack(L);
  writeln('skolko chisel?');
  readln(k);
  writeln('vvedite po cifre vse chisla');
  for i := 1 to k do
  begin
    for  j:=1 to n do
        read(ch[j]);
    InStack(L,ch);
  end;
  Print(L);
  writeln;
  for i:=0 to 9 do InitStack(a[i]);
  for i := n downto 1  do
  begin
       while not EmptyStack(L) do
       begin
           PopStack(L,ch);
           for j:=0 to 9 do
              if ch[i]=j then InStack(a[j],ch);
       end;
       for j:=0 to 9 do
          if  not EmptyStack(a[j]) then
          begin
            for k:=j+1 to 9 do
              if not EmptyStack(a[k]) then
              begin
                b:=k;
                break
              end;
            a[j]^.next:=a[b];
          end;
  end;
  for j:=0 to 9 do
       begin
          if not EmptyStack(a[j]) then L:=a[j];
          break
       end;
end;  {upor}
begin
  Upor(L);
  Print(L);
  readln
end.

[Fireblade-fan]

...........