fork download
copy 
  1. program ideone;
  2.  
  3. {$MODE OBJFPC}{$LONGSTRINGS ON}
  4.  
  5. uses
  6.   HeapTrc;
  7.  
  8. type
  9.   PNode = ^TNode;
  10.   TNode = record
  11.     Next: PNode;
  12.     Prev: PNode;
  13.     Data: UInt8;
  14.   end;
  15.  
  16.   procedure CreateList(out AHead: PNode; const AData: array of UInt8);
  17.   var
  18.     LLast, LNew: PNode;
  19.     LIndex: Integer;
  20.   begin
  21.     New(AHead);
  22.     AHead^.Next := nil;
  23.     AHead^.Prev := nil;
  24.     AHead^.Data := AData[0];
  25.  
  26.     LLast := AHead;
  27.  
  28.     for LIndex := 1 to High(AData) do
  29.     begin
  30.       New(LNew);
  31.       LNew^.Next := nil;
  32.       LNew^.Prev := LLast;
  33.       LNew^.Data := AData[LIndex];
  34.  
  35.       LLast^.Next := LNew;
  36.       LLast := LNew;
  37.     end;
  38.   end;
  39.  
  40.   procedure DisposeList(var AHead: PNode);
  41.   var
  42.     LToDispose: PNode;
  43.   begin
  44.     while AHead <> nil do
  45.     begin
  46.       LToDispose := AHead;
  47.       AHead := AHead^.Next;
  48.  
  49.       Dispose(LToDispose);
  50.     end;
  51.  
  52.     AHead := nil;
  53.   end;
  54.  
  55.   procedure SplitList(const ALeftHead: PNode; out ARightHead: PNode; ACutAfter: Integer);
  56.   var
  57.     LLeftLast: PNode;
  58.   begin
  59.     LLeftLast := ALeftHead;
  60.  
  61.     while ACutAfter > 0 do
  62.     begin
  63.       LLeftLast := LLeftLast^.Next;
  64.       Dec(ACutAfter);
  65.     end;
  66.  
  67.     ARightHead := LLeftLast^.Next;
  68.     ARightHead^.Prev := nil;
  69.  
  70.     LLeftLast^.Next := nil;
  71.   end;
  72.  
  73.   procedure ShowList(AHead: PNode);
  74.   begin
  75.     Write('from head to tail: ');
  76.  
  77.     while AHead^.Next <> nil do
  78.     begin
  79.       Write(AHead^.Data:2);
  80.       AHead := AHead^.Next;
  81.     end;
  82.  
  83.     WriteLn(AHead^.Data:2);
  84.     Write('from tail to head: ');
  85.  
  86.     while AHead <> nil do
  87.     begin
  88.       Write(AHead^.Data:2);
  89.       AHead := AHead^.Prev;
  90.     end;
  91.  
  92.     WriteLn(LineEnding);
  93.   end;
  94.  
  95. var
  96.   LLeftHead, LRightHead: PNode;
  97. begin
  98.   CreateList(LLeftHead, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);
  99.   ShowList(LLeftHead);
  100.  
  101.   SplitList(LLeftHead, LRightHead, 6);
  102.   ShowList(LLeftHead);
  103.   ShowList(LRightHead);
  104.  
  105.   DisposeList(LLeftHead);
  106.   DisposeList(LRightHead);
  107. end.
  108.  
stdin
copy 
Standard input is empty
stdout
copy 
from head to tail:  0 1 2 3 4 5 6 7 8 9
from tail to head:  9 8 7 6 5 4 3 2 1 0

from head to tail:  0 1 2 3 4 5 6
from tail to head:  6 5 4 3 2 1 0

from head to tail:  7 8 9
from tail to head:  9 8 7
stderr
copy 
Heap dump by heaptrc unit
10 memory blocks allocated : 120/160
10 memory blocks freed     : 120/160
0 unfreed memory blocks : 0
True heap size : 32768
True free heap : 32768
https://ideone.com/eyny7f
language:
Pascal (fpc 3.0.4)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!