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.     Data: UInt8;
  13.   end;
  14.  
  15.   procedure CreateList(out AHead: PNode; const AData: array of UInt8);
  16.   var
  17.     LLast, LNew: PNode;
  18.     LIndex: Integer;
  19.   begin
  20.     New(AHead);
  21.     AHead^.Next := nil;
  22.     AHead^.Data := AData[0];
  23.  
  24.     LLast := AHead;
  25.  
  26.     for LIndex := 1 to High(AData) do
  27.     begin
  28.       New(LNew);
  29.       LNew^.Next := nil;
  30.       LNew^.Data := AData[LIndex];
  31.  
  32.       LLast^.Next := LNew;
  33.       LLast := LNew;
  34.     end;
  35.   end;
  36.  
  37.   procedure DisposeList(var AHead: PNode);
  38.   var
  39.     LToDispose: PNode;
  40.   begin
  41.     while AHead <> nil do
  42.     begin
  43.       LToDispose := AHead;
  44.       AHead := AHead^.Next;
  45.  
  46.       Dispose(LToDispose);
  47.     end;
  48.  
  49.     AHead := nil;
  50.   end;
  51.  
  52.   procedure SplitList(const ALeftHead: PNode; out ARightHead: PNode; ACutAfter: Integer);
  53.   var
  54.     LLeftLast: PNode;
  55.   begin
  56.     LLeftLast := ALeftHead;
  57.  
  58.     while ACutAfter > 0 do
  59.     begin
  60.       LLeftLast := LLeftLast^.Next;
  61.       Dec(ACutAfter);
  62.     end;
  63.  
  64.     ARightHead := LLeftLast^.Next;
  65.     LLeftLast^.Next := nil;
  66.   end;
  67.  
  68.   procedure ShowList(AHead: PNode);
  69.   begin
  70.     while AHead <> nil do
  71.     begin
  72.       Write(AHead^.Data:2);
  73.       AHead := AHead^.Next;
  74.     end;
  75.  
  76.     WriteLn();
  77.   end;
  78.  
  79. var
  80.   LLeftHead, LRightHead: PNode;
  81. begin
  82.   CreateList(LLeftHead, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);
  83.   ShowList(LLeftHead);
  84.  
  85.   SplitList(LLeftHead, LRightHead, 6);
  86.   ShowList(LLeftHead);
  87.   ShowList(LRightHead);
  88.  
  89.   DisposeList(LLeftHead);
  90.   DisposeList(LRightHead);
  91. end.
  92.  
stdin
copy 
Standard input is empty
stdout
copy 
 0 1 2 3 4 5 6 7 8 9
 0 1 2 3 4 5 6
 7 8 9
stderr
copy 
Heap dump by heaptrc unit
10 memory blocks allocated : 80/80
10 memory blocks freed     : 80/80
0 unfreed memory blocks : 0
True heap size : 32768
True free heap : 32768
https://ideone.com/e2G0bX
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!