Une nouvelle version du type pile : le tableau dynamique

  Nous allons redéfinir le type pile comme un tableau de pointeurs sur des tableaux (figure 6.5).

 
Figure 6.5:  Un tableau de pointeurs sur des tableaux de taille fixe

program tabdyn;

const taille=4;
      n=10;

type base = integer;
     tab=array[1..taille] of base;
     ptab=^tab;
     tdyn=array[0..n-1] of ptab;

     pile = record espace : tdyn;
                   index : integer;
            end;

var pairs, impairs : pile;
    x : integer;

procedure initpile(var p:pile);
  var i : integer;
  begin
    p.index:=0;
  end;

function pilevide(p:pile):boolean;
  begin
    pilevide:=(p.index=0);
  end;

procedure empiler(var p:pile; e:base);
  var nmax : integer;
  begin
    nmax:=n*taille;

    if (p.index=nmax) then writeln('empilement impossible')
    else if ((p.index mod taille)=0) then 
       begin
         new(p.espace[(p.index div taille)]); 
         p.espace[(p.index div taille)]^[1]:=e;
         p.index:=p.index+1;
       end
    else 
       begin
        p.espace[(p.index div taille)]^[(p.index mod taille)+1]:=e;
        p.index:=p.index+1;
       end;
   end;

procedure depiler(var p:pile; var e:base);
  begin
    if pilevide(p) then writeln('impossible de depiler')
    else if ((p.index mod taille)=1) then
         begin
              e:=p.espace[(p.index div taille)]^[1];
              dispose(p.espace[(p.index div taille)]);
              p.index:=p.index-1;
         end
    else begin
          e:=p.espace[((p.index-1) div taille)]^[((p.index-1) mod taille)+1];
          p.index:=p.index-1;
         end;
  end;

begin
    initpile(pairs);
    initpile(impairs);
    writeln('Entrez des nombres entiers, pour arreter entrez 0');
    readln(x);
    while (x<>0) do
      begin
          if (x mod 2 = 0) then empiler(pairs,x)
                           else empiler(impairs,x);
          readln(x);
      end;

    writeln('Les nombres pairs que vous avez entres sont ');
    while not(pilevide(pairs)) do
          begin
                depiler(pairs, x);
                writeln(x);
          end;

    writeln('Les nombres impairs que vous avez entres sont ');
    while not(pilevide(impairs)) do
          begin
                depiler(impairs, x);
                writeln(x);
          end;
end.