with Unchecked_Deallocation;
package body Stack_Pack is

   -- SCCS_ID : constant String := "@(#) stack.ada, Version 1.2";

   type Node is record
      Datum : Element;
      Next  : Link;
   end record;

   function Top_Value (S : in Stack) return Element is
   begin
      if S.Top = null then
         raise Stack_Underflow;
      else
         return S.Top.Datum;
      end if;
   end Top_Value;

   function Depth_Of_Stack (S : in Stack) return Natural is
   begin
      return S.Tos;
   end Depth_Of_Stack;

   procedure Make_Stack (S : out Stack) is
   begin
      S := (Tos => 0, Top | Extras => null);
   end Make_Stack;

   procedure Push (S : in out Stack; Value : in Element) is
      New_Node : Link;
   begin
      S.Tos := S.Tos + 1;
      if S.Extras = null then
         New_Node := new Node;
      else
         New_Node := S.Extras;
         S.Extras := S.Extras.Next;
      end if;
      New_Node.all := (Datum => Value, Next => S.Top);
      S.Top        := New_Node;
   end Push;

   procedure Pop (S : in out Stack; Value : out Element) is
      Temp : Link;
   begin
      if S.Tos = 0 then
         raise Stack_Underflow;
      end if;

      Value := S.Top.Datum;

      Temp       := S.Top.Next;
      S.Top.Next := S.Extras;
      S.Extras   := S.Top;
      S.Top      := Temp;

      S.Tos := S.Tos - 1;
   end Pop;

   procedure Free is new Unchecked_Deallocation (Node, Link);

   -- procedure free(x : link);
   -- pragma interface(c , free);

   procedure Free_List (List : in out Link) is
      Temp : Link;
   begin
      Temp := List;
      while Temp /= null loop
         List := List.Next;
         Free (Temp);
         Temp := List;
      end loop;
   end Free_List;

   procedure Free_Stack (S : in out Stack) is
   begin
      Free_List (S.Top);
      Free_List (S.Extras);
   end Free_Stack;

end Stack_Pack;
