-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
-- Public License for more details. You should have received a copy of the GNU
-- General Public License distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

package body Heap
--158 refinement clause removed
is

   --158 new procedure
   procedure Initialize (TheHeap : out HeapRecord) is
   begin
      TheHeap.HighMark     := Atom (0);
      TheHeap.NextFreeAtom := Atom (0);
      --# accept F, 23, TheHeap.ListOfAtoms, "Partial initialization" &
      --#        F, 602, TheHeap, TheHeap.ListOfAtoms, "Partial initialization";
      TheHeap.ListOfAtoms (0).PointerA := 0;
      TheHeap.ListOfAtoms (0).PointerB := 0;

   end Initialize;

   --------------------------------------------------------------------

   procedure CreateAtom (TheHeap : in out HeapRecord;
                         NewAtom :    out Atom;
                         Success :    out Boolean) is
      A : Atom;
   begin
      --160--new if part
      if TheHeap.HighMark < Atom (ListLength) then
         --haven't used up array yet
         TheHeap.HighMark                 := TheHeap.HighMark + 1;
         A                                := TheHeap.HighMark;
         TheHeap.ListOfAtoms (A).PointerA := 0;
         TheHeap.ListOfAtoms (A).PointerB := 0;
         NewAtom                          := A;
         Success                          := True;
      elsif TheHeap.NextFreeAtom = 0 then
         --160--if turned into elsif
         --array and returned atoms in free list both used up
         Success := False;
         NewAtom := 0;
      else
         --array used up but there are atoms in the returned free list
         A                                := TheHeap.NextFreeAtom;
         TheHeap.NextFreeAtom             := TheHeap.ListOfAtoms (TheHeap.NextFreeAtom).PointerA;
         TheHeap.ListOfAtoms (A).PointerA := 0;
         TheHeap.ListOfAtoms (A).PointerB := 0;
         NewAtom                          := A;
         Success                          := True;
      end if;
   end CreateAtom;

   --------------------------------------------------------------------

   procedure DisposeOfAtom (TheHeap : in out HeapRecord;
                            OldAtom : in     Atom) is
   begin
      TheHeap.ListOfAtoms (OldAtom).PointerA := TheHeap.NextFreeAtom;
      TheHeap.NextFreeAtom                   := OldAtom;
   end DisposeOfAtom;

   --------------------------------------------------------------------

   function APointer (TheHeap : HeapRecord;
                      A       : Atom) return Atom is
   begin
      return TheHeap.ListOfAtoms (A).PointerA;
   end APointer;

   --------------------------------------------------------------------

   function BPointer (TheHeap : HeapRecord;
                      A       : Atom) return Atom is
   begin
      return TheHeap.ListOfAtoms (A).PointerB;
   end BPointer;

   --------------------------------------------------------------------

   function AValue (TheHeap : HeapRecord;
                    A       : Atom) return HeapIndex.IndexType is
   begin
      return TheHeap.ListOfAtoms (A).ValueA;
   end AValue;

   --------------------------------------------------------------------

   function BValue (TheHeap : HeapRecord;
                    A       : Atom) return HeapIndex.IndexType is
   begin
      return TheHeap.ListOfAtoms (A).ValueB;
   end BValue;

   --------------------------------------------------------------------

   procedure UpdateAPointer (TheHeap : in out HeapRecord;
                             A       : in     Atom;
                             Pointer : in     Atom) is
   begin
      TheHeap.ListOfAtoms (A).PointerA := Pointer;
   end UpdateAPointer;

   --------------------------------------------------------------------

   procedure UpdateBPointer (TheHeap : in out HeapRecord;
                             A       : in     Atom;
                             Pointer : in     Atom) is
   begin
      TheHeap.ListOfAtoms (A).PointerB := Pointer;
   end UpdateBPointer;

   --------------------------------------------------------------------

   procedure UpdateAValue (TheHeap : in out HeapRecord;
                           A       : in     Atom;
                           Value   : in     HeapIndex.IndexType) is
   begin
      TheHeap.ListOfAtoms (A).ValueA := Value;
   end UpdateAValue;

   --------------------------------------------------------------------

   procedure UpdateBValue (TheHeap : in out HeapRecord;
                           A       : in     Atom;
                           Value   : in     HeapIndex.IndexType) is
   begin
      TheHeap.ListOfAtoms (A).ValueB := Value;
   end UpdateBValue;

   --------------------------------------------------------------------

   --159 new function used in RefList
   function IsNullPointer (A : Atom) return Boolean is
   begin
      return (A = 0);
   end IsNullPointer;

end Heap;
