program Aufgabe (input, output);
{ Testprogramm fuer die Funktion ListenMerge >}
type
tRefListe = ^tListe;
tliste = record
info : integer;
next : tRefListe
end;
tNatZahlPlus = 1..maxint;
var
Liste,
Listel,

Liste2 : tRefListe;
Laenge : tNatZahlPlus;
function ListenMerge (
inliste1,
inListe2 : tRefListe) : tRefListe;
{ fasst die Elemente der nicht-leeren und gleich langen Listen
inlistel und inListe mit dem Reissverschlussverfahren durch
Aenderung der Verkettung zu einer einzigen Liste zusammen
und gibt einen Zeiger auf den Anfang der Ergebnisliste
zurück }
var
outliste,
sohn,
vater: tRefListe;
begin
listenmerge := inliste1;
sohn := inListe2;
outliste := inliste1;
vater := inListe1;
while sohn <> nil do
begin
  vater:=vater^.next;
  outliste^.next := sohn;

  outliste:=outliste^.next;
  sohn := sohn^.next;
  outliste^.next := vater;
  vater:=outliste^.next;
  outliste:=outliste^.next


end
end; { ListenMerge }
procedure ListeAufbauen (
inAnz : tNatZahlPlus;
var ioliste : tRefListe );
{ liest inAnz Zahlen von der Tastatur ein und speichert sie in
der Reihenfolge der Eingabe in der linearen Liste ioliste >}
var
Zahl : integer;
AnfListe,
EndListe,
hilf : tRefListe;
k : tNatZahlPlus;

begin
AnfListe := nil;
writeln ('Bitte ', inAnz, 'natuerliche Zahlen eingeben:');
for k := 1 to inAnz do
begin
read (Zahl);
new (hilf) ;
hilf^.info := Zahl;
hilf^.next := nil;
if AnfListe = nil then
begin
{ erste Zahl }
AnfListe := hilf;
EndListe := hilf
end
else
begin
{ zweite und weitere Zahlen }
EndListe^.next := hilf;
EndListe := hilf
end
end;
ioliste := AnfListe
end; { ListeAufbauen >}
begin
writeln ('Bitte die Listenlaenge eingeben (>O) : ');
readln (Laenge);
ListeAufbauen (Laenge, Listel);
ListeAufbauen (Laenge, Liste2);
Liste := ListenMerge (Listel, Liste2);
writeln ('Die "verkettete" Liste lautet:');
repeat
write (Liste^.info);
Liste := Liste^.next
until Liste = nil
end. { Aufgabe}
Anfang  zurück