type link=^node;
node=record
key:word;
next:link
end;
TStackemulator=class
head,z:link;
constructor create(a:word);
destructor destroy;
override;
procedure push(v:word);
function pop:word;
function isempty(autodelete:boolean):boolean;
procedure pop3(
var a,b,c:word);
procedure push3(a,b,c:word);
end;
constructor TStackemulator.create(a:word);
var l:word;
begin
new(head);
new(z);
head^.next:=z;
z^.next:=z;
for l:=1
to a
do push(0)
end;
destructor TStackemulator.destroy;
begin
//inherited//funktioniert auch hier und sogar mit beiden inherited
z^.next:=nil;
head^.next:=nil;
z:=nil;
head:=nil;
dispose(z);
dispose(head);
inherited
end;
procedure TStackemulator.push(v:word);
var t:link;
begin
new(t);
t^.key:=v;
t^.next:=head^.next;
head^.next:=t
end;
function TStackemulator.pop:word;
var t:link;
begin
t:=head^.next;
result:=t^.key;
head^.next:=t^.next;
dispose(t)
end;
function TStackemulator.isempty(autodelete:boolean):boolean;
begin
result:=head^.next=z;
if result
and autodelete
then destroy
end;
procedure TStackemulator.push3(a,b,c:word);
begin
push(a);
push(b);
push(c)
end;
procedure TStackemulator.pop3(
var a,b,c:word);
begin
c:=pop;
b:=pop;
a:=pop
end;
procedure mergesort(links,rechts:word);
label 1,2;
var mitte,Position:word;
Stackemulator:TStackemulator;
begin
Stackemulator:=TStackemulator.create(3);
//mit 3 Leerelementen ("0") füllen, da (bei diesem Algorithmus) immer 3 Elemente abgelegt und abgerufen werden
repeat
mitte:=(links+rechts)
div 2;
if links<mitte
then
begin
Stackemulator.push3(links,rechts,1);
rechts:=mitte;
continue
end;
1:
if succ(mitte)<rechts
then
begin
Stackemulator.push3(links,rechts,2);
links:=succ(mitte);
continue
end;
2:merge(links,mitte,rechts);
//hier einen beliebigen Mergealgorithmus einfügen bzw. ausführen, 1. Teilarray: von links bis mitte, 2. Teilarrary: von mitte+1 bis rechts
Stackemulator.pop3(links,rechts,Position);
mitte:=(links+rechts)
div 2;
case Position
of
1:
goto 1;
2:
goto 2
end
until Stackemulator.isempty(true)
//bei Leersein automatisch löschen
end;