Прошу помочь с задачей

uses crt;

const n=10;

type
    TItem = record
        value: integer;
        num: integer;
    end;

    TStekMas = array [1..n] of TItem;
    TMassiv = array [1..n] of integer;

    TStek = record
        massiv: TStekMas;
        top: integer;
    end;

procedure push(var stk: TStek; var  element: TItem; l: integer);
    begin
        if stk.top<l then
            begin
                stk.top:=stk.top+1;
                stk.massiv[stk.top]:=element;
            end;
    end;

procedure  pop(var stk: TStek; var j: TItem);
    begin
        j:=stk.massiv[stk.top];
        stk.top:= stk.top-1;
    end;

procedure renum(var element: TItem; massiv: TMassiv);
    begin
        element.value:=massiv[element.num];
    end;

procedure writestek(stk: TStek; l: integer);
    var
        j: integer;
    begin
        for j:=1 to l do write(stk.massiv[j].value);
        writeln('');
    end;

function summa(massiv: TMassiv; b: integer):integer;
    var x,i: integer;
    begin
        x:=0;
        for i:=1 to (b) do
            begin
                x:=x+massiv;
            end;
        summa:=x;
    end;
var
    flag: boolean;
    i, number, lenght: integer;
    stek: TStek;
    mas: TMassiv;
    x: TItem;

begin
    clrscr;
    {zapolnim massiv}
    write('vvedite chislo: ');
    readln(number);
    lenght:=trunc(ln(number)/ln(10))+1;
    for i:=1 to lenght do
            begin
                 mas:= (number mod trunc(exp(i*ln(10)))) div trunc(exp((i-1)*ln(10)));
            end;
    {start!}
    writeln('variantu vuborok');
    repeat
        if stek.top = lenght then writestek(stek, lenght);
        if flag or (stek.top=lenght) then
            begin
                flag:=false;
                pop(stek,x);
                if x.num<lenght then
                    begin
                        x.num:=x.num+1;
                        renum(x,mas);
                        push(stek,x, lenght);
                    end
                else flag:=true;
                        end;
        if not flag and (stek.top<lenght) then
            begin
                x.num:=1;
                renum(x,mas);
                push(stek,x,lenght);
            end;
    until flag and (stek.top = 0);
end.

Program chisla;
const
m={максимальное количество чисел};
type
massive=array[1..m] of byte;
tf=array[1..m] of boolean;
var
mas,chisla: massive;
used: tf;
n,i: byte;
procedure p(i: byte; var mas: massive; var used: tf; const chisla: massive; const n: byte);
label
exit;
var
j: byte;
begin
If i=n+1 then begin
for j:=1 to n do
write('  ',mas[j]);
writeln;
Goto exit;
end;
for j:=1 to n do
If not(used[j]) then begin
mas:=chisla[j];
used[j]:=true;
p(i+1,mas,chisla,used,n);
used[j]:=false;
end;
exit:
end;
begin
writeln(' Vvedite kol-vo chisel ');
read(n);
writeln(' Vvedite Chisla ');
for i:=1 to n do
readln(chisla);
for i:=1 to m do
used:=false;
a:=1;
p(a,mas,chisla,used,n);
write(' Press any key to continue... ');
repeat until keypressed;
writeln;
end.