Power-Programmierung/CD1.mdf/pascal/library/dos/arrays/generics/genlist/genlist.pas

Pascal/Delphi Source File | 1989-07-24 | 10.8 KB | 336 lines

Unit GenList;  {Generic Fully Dynamic Doubly-Linked List w/ArrayLike extras}
{$R-,O+}

{ Unit GenList  written by Eric C. Wentz -- Last Mod Data 7/8/89 }

{ Unit GenList introduces the LinkedList equivalent of the FlexArray datatype }
{ Lists are allocated dynamically on the Heap, but as they are allocated on a }
{ node-by-node basis, they can grow to occupy the entire Heap.  This is their }
{ only superiority over the FlexArray type.  FlexArray's will perform quite a }
{ bit faster for all operations, and take up much less overhead (since there  }
{ are TWO pointers associated with each element in a List).  Nevertheless,    }
{ for Lists/Arrays of LARGE data structures, or simply huge lists of smaller  }
{ structures, Lists should prove quite handy.                                 }

{ All Lists (and descendant objects) MUST be CREATEd before any other         }
{ operations are performed upon them.  Using CREATE to re-initialize          }
{ may well lead to system crashes, so DON'T do it!  By using DESTROY and      }
{ then INITting again, you can re-use the List type for whatever purpose      }
{ deemed appropriate.  As ListS use Untyped Variables to achieve Genericity,  }
{ you MUST tell the List how many bytes to expect -- use SizeOf.              }
{ Procedures RESETELEMENT_N and GETELEMENT_N provide Array-like access to     }
{ Established Lists, and DO check current bounds of List.  Attempting to      }
{ Access beyond these bounds is an error and will terminate the program!      }
{ Procedures APPEND, DELETE and INSERTAFTER_N are more ListSpecific .         }
{ APPEND is used to add new elements to the "end" of the List.  Insertion at  }
{ a particular index is accomplished with INSERTAFTER_N, and deletion of a    }
{ given element is similarly handled by DELETE.  REMEMBER: For DELETE and     }
{ methods ending in "_N", it is a program-terminating error to attempt to     }
{ access the List outside of it's (Current) boundaries!! Procedure LISTCOPY   }
{ will copy one list to another (if enough memory) and is of necessity very   }
{ slow. Finally, Functions ElemSize and CurrentLength provide important info  }
{ as to (Current) List status.  Procedure ReWind is provided only to speed up }
{ those List Accesses which will be sequential, starting from the "Top", and  }
{ is generally not particularly useful or needed.  It merely goes directly to }
{ the "Top", where the "_N" methods must run down the pointers to reach the   }
{ "Top".  Calling it once will suffice to speed up sequential accesses.       }
{ Note, here I am using Top in the sense of a FIFO Queue, NOT as in a Stack!  }

{ LAST MOD: Added Function Node_N for more direct access to Nodes, as needed  }
{ in Unit GenHeap, which defines the Heap structured variant of this List.    }

{ NOTE: Lists (as defined here) are "indexed" 1..CurrentLength }
{       CurrentLength = 0 equates to Empty List                }

INTERFACE

Uses DoubLink,FlexPntr;

Type
  List = Object
    (**********************************************************************)
    { GENERAL NOTE: Every time the parameter "Size" is specified, you MUST }
    {               use SizeOf(<inputvariable>) to ensure correctness!!    }
    (**********************************************************************)

    NumElems  : LongInt; { It would be best if Turbo provided a PRIVATE   }
    DatumSize : Word;    { declaration (ala ADA) as no code outside this  }
    CurElem   : Word;    { unit has any business mucking about with these }
    Head      : DPtr;    { six instance variables. Unfortunately, Turbo   }
    Tail      : DPtr;    { does not, so these must remain "visible" to    }
    Cursor    : DPtr;    { external code.  DON'T ACCESS 'EM DIRECTLY !!   }

    Procedure Create;{ List Must be CREATEd EXACTLY once, and before all else }

    Procedure Init (Size : Word);  { Once CREATEd, you may Re-Use a List }
    Procedure Destroy;             { by DESTROYing and then Re-INITting  }

    Function CurrentLength : LongInt;   { Report Current Length of List }
    Function ElemSize : Word;           { Report Size of List Elements  }
    Function Current : LongInt;         { Where is "Cursor" ?           }
    Procedure ReWind;                   { Go To the "Top" of the List   }

    Procedure Append (Var InData; Size : Word); { Add InData to END of List  }
                                                { automatically "grows" List }

    Procedure GetElement_N (Var OutData; N : LongInt; Size : Word);

                           { Return value of Nth member of List    }
                           { legal N's are from 1..CurrentLength   }
                           { Only legal size is equal to ElemSize. }

    Procedure ReSetElement_N (Var InData; N : LongInt; Size : Word);

                           { Re-Assign value of Nth member of List }
                           { legal N's are form 1..CurrentLength   }
                           { Only legal size is equal to ElemSize. }

    Procedure Delete (N : LongInt); { Delete Nth Element }

    Procedure InsertAfter_N (Var InData; N : LongInt; Size : Word);

                           { Insert new value into list AFTER Nth element }

    Procedure Copy (L : List); { Target List MUST be CREATEd or DESTROYed }

    Function Node_N (N : LongInt) : DPtr; { Returns a Pointer to the Nth Node }
                                        { See Unit LGenHeap for correct usage }
  End;


IMPLEMENTATION

Procedure ListError (Num : Byte);
Begin
  WriteLn;
  Write ('ListArray ERROR: ');
  Case Num of
           0 : WriteLn ('Attempted to Insert wrong size data Element.');
           1 : WriteLn ('Attempted GetElement with wrong size variable.');
           2 : WriteLn ('Attempted to index past current end of List.');
           3 : WriteLn ('Attempted ReSetElement with wrong size variable.');
           4 : WriteLn ('Attempted to delete past current bounds of List.');
           5 : WriteLn ('Attempted to insert past current bounds of List.');
           6 : WriteLn ('Attempted InsertAfter with wrong size data Element.');
           7 : WriteLn ('Attempted Function Node_N beyond Current Length.');
           8 : WriteLn ('**** OUT OF MEMORY ERROR ****');
          End;
  WriteLn ('**** PROGRAM TERMINATED ****');
  WriteLn;
  Write ('Press <Return> to Continue.... ');
  ReadLn;
  HALT (0)
End;

Procedure List.Create;
Begin
  Head := Nil;
  Tail := Nil;
  Cursor := Nil;
  CurElem := 0;
  DatumSize := 0;
  NumElems := 0
End;

Procedure List.Init (Size : Word);
Begin
  DatumSize := Size;
  NumElems := 0
End;

Procedure List.Destroy;
Var
  Temp : DPtr;
Begin
  Temp := Tail;
  While Tail <> Head do
    Begin
      Cursor := Tail^.Prev;
      Temp^.Prev := Nil;
      Temp^.Destroy;
      Tail := Cursor;
      Tail^.Next := Nil;
      Temp := Tail
    End;
  Head^.Destroy;
  Dispose (Temp);
  Dispose (Cursor);
  Dispose (Head);
  Dispose (Tail);
  CurElem := 0;
  DatumSize := 0;
  NumElems := 0
End;

Function List.CurrentLength : LongInt;
Begin
  CurrentLength := NumElems
End;

Function List.ElemSize : Word;
Begin
  ElemSize := DatumSize
End;

Function List.Current : LongInt;
Begin
  Current := CurElem
End;

Procedure List.Append (Var InData; Size : Word);
Var
  Temp : DPtr;
Begin
  If Size <> DatumSize Then ListError (0);
  New (Temp);
  If Temp = Nil Then ListError (8);
  Temp^.Create;
  Temp^.Init (DatumSize);
  Temp^.Set_Data (InData,Size);
  If NumElems = 0
    Then
      Begin
        Head := Temp;
        Tail := Head;
        Cursor := Head;
        CurElem := 1;
        NumElems := 1
      End
    Else
      Begin
        Tail^.Next := Temp;
        Temp^.Prev := Tail;
        Tail := Temp;
        NumElems := NumElems + 1
      End
End;

Procedure GoTo_N (Var L : List; N : LongInt);  {This is NOT an exported}
Begin                                          {method, to prevent abuse!}
  With L do
    If CurElem <> N Then
      Begin
        While N < CurElem do
            Begin
              Cursor := Cursor^.Prev;
              CurElem := CurElem - 1
            End;
        While N > CurElem do
            Begin
              Cursor := Cursor^.Next;
              CurElem := CurElem + 1
            End
      End
End;

Procedure List.ReWind;
Begin
  CurElem := 1;
  Cursor := Head
End;

Procedure List.GetElement_N (Var OutData; N : LongInt; Size : Word);
Begin
  If Size <> DatumSize Then ListError (1);
  If ((N > NumElems) or (N < 1)) Then ListError (2);
  GoTo_N (Self,N);
  Cursor^.Get_Data (OutData,Size)
End;

Procedure List.ReSetElement_N (Var InData; N : LongInt; Size : Word);
Begin
  If Size <> DatumSize Then ListError (3);
  If ((N > NumElems) or (N < 1)) Then ListError (2);
  GoTo_N (Self,N);
  Cursor^.Set_Data (InData,Size)
End;

Procedure List.Delete (N : LongInt);
Var
  Temp : DPtr;
Begin
  If ((N > NumElems) or (N < 1)) Then ListError (4);
  GoTo_N (Self,N);
  Temp := Cursor;
  NumElems := NumElems - 1;
  If ((Cursor <> Tail) and (Cursor <> Head))
    Then
      Begin
        Cursor^.Prev^.Next := Cursor^.Next;
        Cursor^.Next^.Prev := Cursor^.Prev;
        Cursor := Cursor^.Next;
        Temp^.Next := Nil;
        Temp^.Prev := Nil;
        Temp^.Destroy
      End
    Else
      If (Cursor = Head)
        Then
          Begin
            Head := Head^.Next;
            Head^.Prev := Nil;
            Cursor := Head;
            Temp^.Next := Nil;
            Temp^.Destroy
          End
        Else    {Cursor = Tail}
          Begin
            Tail := Tail^.Prev;
            Tail^.Next := Nil;
            Cursor := Tail;
            Temp^.Prev := Nil;
            Temp^.Destroy
          End;
  Dispose (Temp)
End;


Procedure List.InsertAfter_N (Var InData; N : LongInt; Size : Word);
Var
  Temp : DPtr;
Begin
  If ((N > NumElems) or (N < 1)) Then ListError (5);
  If Size <> DatumSize Then ListError (6);
  GoTo_N (Self,N);
  NumElems := NumElems + 1;
  New (Temp);
  If Temp = Nil Then ListError (8);
  Temp^.Create;
  Temp^.Init (Size);
  Temp^.Set_Data (InData,Size);
  Temp^.Next := Cursor^.Next;
  Temp^.Prev := Cursor;
  Cursor^.Next^.Prev := Temp;
  Cursor^.Next := Temp
End;

Procedure List.Copy (L : List);
Var
  I : LongInt;
  D : FlexPtr;
  W : Word;
Begin
  Init (L.ElemSize);
  L.ReWind;
  GetMem (D,SizeOf(FlexCount) + L.ElemSize);
  If D = Nil Then ListError (8);
  For I := 1 to L.CurrentLength do
    Begin
      L.GetElement_N (D^.Flex,I,L.ElemSize);
      Append (D^.Flex,L.ElemSize)
    End;
  FreeMem (D,SizeOf(FlexCount) + L.ElemSize)
End;

Function List.Node_N (N : LongInt) : DPtr;
Begin
  If N > CurrentLength Then ListError (7);
  GoTo_N (Self,N);
  Node_N := Cursor
End;

BEGIN
  HeapError := @HeapErrorTrap  {Exported from FlexPntr}
END.