Never been to DZone Snippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

About this user

Piotr

« Newer Snippets
Older Snippets »
Showing 1-1 of 1 total  RSS 

Single linked list unit

This code is a simple pascal library to handle single-linked-lists

function llsGetItem(id: cardinal; var start: pointer): pointer;

Returns an item of specified ID, it remains in list

function llsTakeOutItem(id: cardinal; var start: pointer): pointer;

Returns an item of specified ID, it is removed from list

procedure llsInsertItem(item: pointer; var start: pointer);

Inserts an item to list(item is a valid header)

function llsGetItemCount(start: pointer): cardinal;

Gets number of items

function llsNewSLLHeader: PSLLItem;

Allocates list item header

procedure llsKillSLLHeader(hdr: pointer);

Deallocated list item header
   1  
   2  unit SLLMan;
   3  interface
   4  type
   5    PSLLItem = ^TSLLItem;
   6    TSLLItem = record
   7      Next: pointer;
   8      Data: pointer;
   9     end;
  10  
  11  function llsGetItem(id: cardinal; var start: pointer): pointer;
  12  function llsTakeOutItem(id: cardinal; var start: pointer): pointer;
  13  procedure llsInsertItem(item: pointer; var start: pointer);
  14  function llsGetItemCount(start: pointer): cardinal;
  15  function llsNewSLLHeader: PSLLItem;
  16  procedure llsKillSLLHeader(hdr: pointer);
  17         // These ids are numbered from 0
  18  implementation
  19  function malloc(size: cardinal): pointer;
  20  begin
  21    GetMem(result,size);
  22  end;
  23  function llsGetItemCount(start: pointer): cardinal;
  24  var
  25    cur: PSLLItem;
  26    tmp: cardinal;
  27  begin
  28    if start = nil then begin llsGetItemCount := 0; Exit; end;
  29    tmp := 1;  cur := start;
  30    while (cur^.Next <> nil) do
  31    begin
  32      Inc(tmp);
  33      cur := cur^.Next;
  34    end;
  35    llsGetItemCount := tmp;
  36  end;
  37  procedure llsKillSLLHeader(hdr: pointer);
  38  begin
  39    if hdr = nil then Exit;
  40    Free(hdr);
  41  end;
  42  function llsNewSLLHeader: PSLLItem;
  43  var
  44    tmp: PSLLItem;
  45  begin
  46    tmp := malloc(sizeof(TSLLItem));
  47    tmp^.Next := nil;
  48    tmp^.Data := nil;
  49    llsNewSLLHeader := tmp;
  50  end;
  51  function llsGetItem(id: cardinal; var start: pointer): pointer;
  52  var
  53    cur: PSLLItem;
  54  begin
  55    if start = nil then begin llsGetItem := nil; Exit; end;
  56    cur := start;
  57    while (id<>0) do
  58    begin
  59      if cur^.Next <> nil then
  60          begin
  61            Dec(id);
  62            cur := cur^.Next;
  63          end else
  64          begin
  65            llsGetItem := nil;
  66            Exit;
  67          end;
  68    end;
  69    llsGetItem := cur;
  70  end;
  71  
  72  function llsTakeOutItem(id: cardinal; var start: pointer): pointer;
  73  var
  74    tmp: PSLLItem;
  75    last: PSLLItem;
  76  begin
  77    if start = nil then begin llsTakeOutItem := nil; Exit; end;
  78    if (id = 0) then
  79      begin
  80        tmp := start;
  81        if tmp^.Next = nil then start := nil else start := tmp^.Next;
  82        llsTakeOutItem := tmp;
  83        Exit;
  84      end;
  85    tmp := start;
  86    repeat
  87      dec(id);
  88      last := tmp;
  89      tmp := tmp^.Next;
  90    until (id = 0);
  91    last^.Next := tmp^.Next;
  92    llsTakeOutitem := tmp;
  93  end;
  94  procedure llsInsertItem(item: pointer; var start: pointer);
  95  var
  96    cur: PSLLItem;
  97  begin
  98   if start = nil then
  99    begin
 100      start := item;
 101      exit;
 102    end;
 103   cur := start;
 104   while (cur^.Next<>nil) do cur := cur^.Next;
 105   cur^.Next := item;
 106  end;
 107  
 108  end.
 109  
« Newer Snippets
Older Snippets »
Showing 1-1 of 1 total  RSS