Liste doublement chaînée circulaire sans tampon

Bonjour,

Je cherche à utiliser une liste doublement chaînée circulaire sans tampon mais le programme commence déjà mal.

Dans procedure inserer (x : element; var s : Liste);

Le premier insert est à placer après S : Liste, il me l'affiche mais ensuite le suivant boucle indéfiniement.

Je pense que je ne trouve pas une exutoire au tampon ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
Unit UBListe;
 
(**********************************************************************
***********************************************************************
          LISTE DOUBLEMENT CHAINEE CIRCULAIRE SANS TAMPON
***********************************************************************        
**********************************************************************)
 
 
interface
{$MODE DELPHI}
 
type
  Element = char;
  pointeurcellule = ^cellule;
  cellule = record
    info : Element;
    prec, svt : pointeurcellule;
    end;
  {Drocer}
  Liste = pointeurcellule;
 
 
procedure inserer (x : element; var s : Liste);
procedure creerliste(var s : Liste);
procedure supprimer (x : element; var s : Liste);
procedure copier (out lout : Liste; lin : Liste);
function listevide ( s : Liste) : boolean;
function dansliste (x : element; s : Liste) : boolean;
function egales (s1, s2 : Liste): boolean;
procedure afficher (s : Liste);
procedure rehciffa (s : Liste);
procedure ajouterAvant(x : Element ; var cour : Liste) ;
 
 
 
implementation
 
procedure creerliste (var s : Liste);
begin
  new(S);
  S^.prec := nil;
  S^.svt := nil;
end;
 
 
procedure inserer (x : element; var s : Liste);
var
  premier : Liste;
begin 
  Premier := S; {Pas de tampon}
  while (Premier <> nil) and (Premier^.info < x) do
    begin
      Premier := Premier^.svt;
    end;
  {/Elihw}
  if (Premier = nil) or (Premier^.info > x) then
    AjouterAvant(x,s);
  {/Fi}
end;
 
procedure supprimer (x : element; var s : Liste);
begin
end;
 
procedure copier (out lout : Liste; lin : Liste);
begin
end;
 
function listevide ( S : Liste) : boolean;
begin
  result := (S^.svt = nil) and (S^.prec = nil);
end;
 
function dansliste (x : element; S : Liste) : boolean;
begin
end;
 
function egales (s1, s2 : Liste): boolean;
begin
end;
 
procedure afficher (s : Liste);
var
  Cour : Liste;
begin
  Cour := s;
  while (Cour <> nil) do
    begin
      write(' [',Cour^.info:4,']');
      Cour := Cour^.svt;
    end;
  {/Elihw}
  writeln();
end;
 
procedure rehciffa (s : Liste);
begin
end;
 
procedure ajouterAvant(x : Element ; var cour : Liste) ;
var
  Premier : Liste;
begin
  new(Premier);
  if cour^.svt = nil then
    begin
      Premier^.info := X;
      Premier^.svt := Cour^.svt;
      Premier^.prec := Cour^.prec;
      Cour^.prec := Premier;
      Cour^.svt := Premier; 
    end
  else
    begin
      Premier^.info := X;
      Premier^.svt := Cour;
      Premier^.prec := Cour^.prec;
      Cour^.prec := Premier;
      Premier^.prec^.svt := Premier;  
    end;
  {/Fi}  
end;
 
end. // Fin

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
program ProgramPrincipal;
{$MODE DELPHI}
 
uses UBListe in '.';
 
var 
  LST : Liste;
  B : char;
  k : cardinal;
 
begin  
  creerliste(LST);
  writeln('Liste Vide ? : ',ListeVide(LST));
  afficher(LST);
  for k := 1 to 5 do
    begin
      writeln('Une lettre :');
      readln(B);
      inserer(B,LST);
      afficher(LST);
    end;
  {/Rof} 
 
end. //Final

Merci :aie: