(*******************************************************************
 *
 *  ttlists.pas                                                 1.0
 *
 *    Generic lists routines.
 *
 *  Copyright 1996, 1997 by
 *  David Turner, Robert Wilhelm, and Werner Lemberg.
 *
 *  This file is part of the FreeType project, and may only be used
 *  modified and distributed under the terms of the FreeType project
 *  license, LICENSE.TXT. By continuing to use, modify or distribute
 *  this file you indicate that you have read the license and
 *  understand and accept it fully.
 *
 *  IMPORTANT NOTE :
 *
 *    These routines should only be used within managers. As a
 *    consequence, they do not provide support for thread-safety
 *    or re-entrancy.
 *
 ******************************************************************)

Unit TTLists;

interface

{$I TTCONFIG.INC}

uses FreeType, TTTypes;

  (*                                                                   *)
  (* A 'generic' list is made of a series of linked nodes called       *)
  (* 'List_Elements'. Each node contains a 'data' field that is a      *)
  (* pointer to some listed object of any kind. The nature of the      *)
  (* objects of the list isn't important.                              *)
  (*                                                                   *)
  (*    ______      ______       ______                                *)
  (*   |      |    |      |     |      |                               *)
  (* ->| next----->| next------>| next----> NIL                        *)
  (*   | data |    | data |     | data |                               *)
  (*   |__|___|    |__|___|     |__|___|                               *)
  (*      |           |            |                                   *)
  (*      |           |            |                                   *)
  (*      v           v            v                                   *)
  (*  __________   ________    ________                                *)
  (* |          | |        |  |        |                               *)
  (* | Object A | | Obj. B |  | Obj. C |                               *)
  (* |__________| |        |  |________|                               *)
  (*              |________|                                           *)
  (*                                                                   *)
  (*                                                                   *)
  (* The listed objects do not necessarily contain pointers to their   *)
  (* own list element..                                                *)
  (*                                                                   *)
  (* Discarded nodes are recycled in a simple internal list called     *)
  (* 'Free_Elements'.                                                  *)
  (*                                                                   *)

type
  PList_Element = ^TList_Element;
  TList_Element = record
                    next : PList_Element; (* Pointer to next element of list *)
                    data : Pointer;       (* Pointer to the listed object    *)
                  end;

  (* Simple list node record. A List element is said to be 'unlinked' *)
  (* when it doesn't belong to any list                               *)

  TSingle_List = record
                   head : PList_Element;
                   tail : PList_Element;
                 end;
  (* Simple singly-linked list record *)

const
  Null_Single_List : TSingle_List = ( head:nil; tail:nil );

  (********************************************************)
  (*                                                      *)
  (* Two functions used to manage list elements           *)
  (*                                                      *)
  (* Note that they're thread-safe in multi-threaded      *)
  (* builds.                                              *)
  (*                                                      *)

  function  Element_New : PList_Element;
  (* Returns a new list element, either fresh or recycled *)
  (* Note : the returned element is unlinked              *)

  procedure Element_Done( element : PList_Element );
  (* Recycles or discards an element.                     *)
  (* Note : The element must be unlinked !!               *)

  (********************************************************)
  (*                                                      *)
  (* Several functions to manager single linked list.     *)
  (*                                                      *)
  (* Note that all these functions assume that the lists  *)
  (* are already protected against concurrent operations  *)
  (* (parsing, modification..)                            *)
  (*                                                      *)

  procedure List_Add( var List : TSingle_List;
                       element : PList_Element );
  (* Adds one element to the end of a single list         *)
  (* Note : The element must be unlinked !!               *)
  (*                                                      *)

  function List_Remove( var List : TSingle_List;
                         element : PList_Element ) : TError;
  (* Removes one element from a list                          *)
  (* Note : The element must be in the argument list before   *)
  (*        the call. It will be unlinked after the call, and *)
  (*        may be discarded through 'Element_Done'..         *)
  (*                                                          *)
  (*        Returns failure when the element isn't part of    *)
  (*        the list..                                        *)

  function List_Find( var List : TSingle_List;
                          data : Pointer ) : PList_Element;
  (* Finds in a list the element corresponding to the object  *)
  (* pointed by 'data'                                        *)
  (* returns nil in case of failure                           *)

  function List_Extract( var List : TSingle_List ) : PList_Element;
  (* returns and extracts the first element of a list, if any. Useful *)
  (* for recycle lists where any element can be taken for reuse.      *)
  (* returns nil in case of failure                                   *)


  function  TTLists_Init : TError;
  procedure TTLists_Done;

implementation

uses TTError,
     TTMemory;

var
  Free_Elements : PList_Element;

(*******************************************************************
 *
 *  Function    :  Element_New
 *
 *  Description :  Gets a new ( either fresh or recycled ) list
 *                 element. The element is unlisted.
 *
 *  Notes  :  returns nil if out of memory
 *
 *****************************************************************)

  function Element_New : PList_Element;
  var
    element : PList_Element;
  begin
    (* LOCK *)

    if Free_Elements <> nil then
      begin
        element       := Free_Elements;
        Free_Elements := element^.next;
      end
    else
      begin
        Alloc( element, sizeof(TList_Element) );
        (* by convention, an allocated block is always zeroed *)
        (* the fields of element need not be set to NULL then *)
      end;

    (* UNLOCK *)

    Element_New := element;
  end;

(*******************************************************************
 *
 *  Function    :  Element_Done
 *
 *  Description :  recycles an unlisted list element
 *
 *  Notes  :  Doesn't check that the element is unlisted
 *
 *****************************************************************)

  procedure Element_Done( element : PList_Element );
  begin
    (* LOCK *)

    element^.next := Free_Elements;
    Free_Elements := element;

    (* UNLOCK *)
  end;

(*******************************************************************
 *
 *  Function    :  List_Add
 *
 *  Description :  Adds a new element to the end of a singly
 *                 linked list.
 *
 *  Notes  :
 *
 *****************************************************************)

 procedure List_Add( var List : TSingle_List;
                      element : PList_Element );
 begin
   {$IFDEF ASSERT}
   if element = nil then
     Panic1( 'TTLists.List_Add : void element' );
   {$ENDIF}

   element^.next := nil;

   if List.head = nil then
     begin
       {$IFDEF ASSERT}
       if List.tail <> nil then
         Panic1( 'TTLists.List_Add : incoherent list tail' );
       {$ENDIF}

       List.head := element;
       List.tail := element;
     end
   else
     begin
       {$IFDEF ASSERT}
       if List.tail = nil then
         Panic1( 'TTLists.List_Add : incoherent list head' );
       {$ENDIF}

       List.tail^.next := element;
       List.tail       := element;
     end;
 end;

(*******************************************************************
 *
 *  Function    :  List_Remove
 *
 *  Description :  Removes a list element from a singly linked list.
 *
 *  Notes  :  Returns false when the element wasn't on the list
 *
 *****************************************************************)

 function List_Remove( var List : TSingle_List;
                        element : PList_Element ) : TError;
 var
   old     : PList_Element;
   current : PList_Element;
 begin
   {$IFDEF ASSERT}
   if (List.head = nil) or (List.tail = nil) then
     Panic1( 'TTLists.List_Remove : void list' );
   {$ENDIF}

   old     := nil;
   current := List.head;

   while current <> nil do
   begin

     if current = element then
     begin
       if old <> nil then old^.next := current^.next
                     else List.head := current^.next;

       if List.tail = current then List.tail := old;

       List_Remove := Success;
       exit;
     end;

     old     := current;
     current := current^.next;

   end;

   {$IFDEF DEBUG}
   Trace1( 'TTLists.List_Remove : element is not in list' );
   {$ENDIF}

   error       := TT_Err_Unlisted_Object;
   List_Remove := Failure;
 end;

(*******************************************************************
 *
 *  Function    :  List_Find
 *
 *  Description :  Finds in a list the element corresponding to
 *                 object pointed by 'data'
 *
 *****************************************************************)

  function List_Find( var List : TSingle_List;
                          data : Pointer ) : PList_Element;
  var
    current : PList_Element;
  begin
    current := List.head;
    while current <> nil do
    begin
      if current^.data = data then
      begin
        List_Find := current;
        exit;
      end;

      current := current^.next;
    end;

    List_Find := nil;
  end;

(*******************************************************************
 *
 *  Function    :  List_Extract
 *
 *  Description :  Extracts the first element of a list. Used for
 *                 recycling lists, where any element can be taken
 *                 for reuse.
 *
 *****************************************************************)

  function List_Extract( var List : TSingle_List ) : PList_Element;
  var
    E : PList_Element;
  begin
    E := List.head;

    if E <> nil then
      begin
        List.head := E^.next;

        if List.tail = E then List.tail := nil;
      end;

    List_Extract := E;
  end;

(*******************************************************************
 *
 *  Function    :  TTLists_Init
 *
 *  Description :  Initialize lists component
 *
 *****************************************************************)

  function TTLists_Init : TError;
  begin
    Free_Elements := nil;
    TTLists_Init  := Success;
  end;

(*******************************************************************
 *
 *  Function    :  TTLists_Done
 *
 *  Description :  Finalize lists component
 *
 *****************************************************************)

  procedure TTLists_Done;
  var
    element, next : PList_Element;
  begin
    element := Free_Elements;
    while ( element <> nil ) do
    begin
      next := element^.next;
      Free( element );
      element := next;
    end;
  end;


end.
