(* Copyright (C) 1990, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* Last modified on Fri May 29 17:12:35 PDT 1992 by muller     *)
(*      modified on Tue Feb 25 09:42:29 PST 1992 by kalsow     *)

UNSAFE INTERFACE RTHeapRep;

(* This interface provides low-level access to the storage allocator
   and garbage collector. *)

IMPORT RT0, Word;
FROM RT0 IMPORT Typecode;

PROCEDURE AllocateUntracedOpenArrayDef (def: RT0.TypeDefinition;
                                     READONLY s: ARRAY OF INTEGER): ADDRESS;


(*-----------------------  collector  ------------------------*)
(*
   The allocator and collector maintain two heaps of objects.
   One heap is "traced" (i.e. objects are garbage collected)
   the other is "untraced".

   A heap is a set of pages.  The pages are aligned, but may not be
   contiguous.
*)

TYPE 
   MonitorClosure <: OBJECT METHODS
                       before ();
                       after (); END;

PROCEDURE RegisterMonitor (cl: MonitorClosure);
(* Just before beginning a collection, the collector will call all
   registered 'before' procedures.  Just after finishing a collection,
   the collector will call all registered 'after' procedures. *)

PROCEDURE UnregisterMonitor (cl: MonitorClosure);
(* removes m's pre and post procedures from the registered set. *)

PROCEDURE CollectNow ();

(*-----------------------  pages  ------------------------*)
(*
   A page is a fixed length array of words that contains
   a packed list of one or more objects.  Pages are aligned.
   All the words in a page are used.  They contain either objects
   allocated by the user or "filler" objects.
*)


CONST
  BytesPerPage  = 2048;
  AdrPerPage    = BytesPerPage;
  PageSize      = BytesPerPage;
  PageAlignment = PageSize;
  WordsPerPage  = 512;

PROCEDURE AllocatePages (n: INTEGER): ADDRESS;
(* return the address of n aligned, contiguous, untraced pages. *)

PROCEDURE MakeCollectible (adr: ADDRESS;  cnt: INTEGER);
(* add the cnt contiguous pages beginning at adr to the collectible
   heap.  It is an unchecked runtime error if adr and cnt do not
   correspond to the values returned by AllocatePages. *)


(*-----------------------  objects  ------------------------*)
(*
   An object is a contiguous array of words.  The first word of an
   object is its header.  The object's body begins at the second
   word, its address is the object's reference.  All object bodies
   are are aligned.

   Objects that are larger than a page span multiple contiguous pages.
   These large objects always begin at a page boundary.  If necessary,
   the final page occupied by a large object is filled by a single filler
   object.
*)

TYPE
  Header = RT0.RefHeader;

CONST
  Fill_1_type: Typecode = LAST (Typecode); (* 1 word filler *)
  FillHeader1: Header   = Header {typecode := Fill_1_type, forwarded := FALSE};
  (* singleton words in a page that do not contain user allocated
     objects contain a "1 word filler" object.  The object is only
     its header.  The header has "Fill_1_type" as its typecode. *)

CONST
  Fill_N_type: Typecode = LAST (Typecode) - 1;
  FillHeaderN: Header   = Header {typecode := Fill_N_type, forwarded := FALSE};
  (* contiguous words in a page that do not contain user allocated
     objects contain an "N word filler" object.  The object is a
     header followed by a count.  The header has "Fill_N_type" as
     its typecode.  The count is an integer specifying the number
     of bytes occupied the the filler object, including the header and
     count words. *) 


PROCEDURE GetSize (r: REFANY): INTEGER;
(* returns the size in bytes of the storage occupied by r.  This size
   includes r's header *)

PROCEDURE DisposeTraced (VAR r: REFANY);
(* deallocate the traced object referenced by r and set r to NIL *)

PROCEDURE DisposeUntraced (VAR a: ADDRESS);
(* deallocate the untraced non-object reference a and set a to NIL *)

PROCEDURE DisposeUntracedObj (VAR a: ADDRESS);
(* deallocate the untraced object referenced by a and set a to NIL *)

   
(*-----------------------  OBJECTs  ------------------------*)
(*
  A Modula-3 object is appears to the collector like any other
  object.  The first word of its body is a pointer to its
  method list.
*)

CONST
  MethodListOffset = 0; (* byte offset into the object's body *)

PROCEDURE SetDefaultMethods (r: ROOT);
(* set the method list pointer in r to the default method suite for
   the type of r. *)

(*-----------------------  open arrays  ------------------------*)
(*
  An open array object with N open dimensions is represented
  by a pointer to the first data element and N integers containing
  the size of the array in the respective dimension.  This extra
  information occupies the first N+1 words of the allocated object.
*)

TYPE
  OpenArrayInfo = RECORD
    data  : ADDRESS;
    shape : ARRAY [0..(*n dimensions*)99999] OF CARDINAL;
  END;


(*-------------------------------------------------------- Initialization ---*)

PROCEDURE CheckTypes ();
(* called after type registration to let the allocator sanity check
   the typecells. *)
   
(*------------------------------------------------ Enable/Disable control ---*)

VAR (*READONLY*)
  collectionProhibited: CARDINAL := 0;
  (* garbage collection is disabled if collectionProhibited > 0. *)

(*------------------------------------------------------------- Debugging ---*)

TYPE
  RefVisitor = OBJECT
               METHODS
                 visit (tc: Typecode;
                        r: REFANY; 
                        size: CARDINAL): BOOLEAN (* RAISES ANY*);
                       (* returns TRUE to continue *)
               END;

PROCEDURE VisitAllRefs (proc: RefVisitor);
  (* Visit all the traced references in the heap, and call proc.visit for 
     each one of them. Garbage collection is disabled during that
     visit and you should refrain from allocating memory in proc. *)

PROCEDURE ShowCounts (READONLY tcs: ARRAY OF Typecode) : MonitorClosure;
PROCEDURE ShowAllCounts () : MonitorClosure;

PROCEDURE GCstatus (mode: INTEGER);



(* We keep the number of allocated pages in a global variable; it
   should satify the invariant:

     allocatedPages = sigma (i = firstAllocatedPage, lastAllocatedPage,
                              space [i-firstAllocatedPage] # Unallocated)
                                  if there are allocated pages,
                      = 0 otherwise.
    
   We also keep the number of active pages in a global; it satisfies:

     activePages = sigma (i = firstAllocatedPage, lastAllocatedPage,
                           space [i-firstAllocatedPage] = nextSpace)
                                if there are allocated pages,
                 = 0 otherwise. *)

VAR
  allocatedPages : CARDINAL := 0;
  smallActivePages : CARDINAL := 0;
  largeActivePages : CARDINAL := 0;

(* The array space and the global variables firstAllocatedPage,
   and lastAllocatedPage indicate which pages are part of the traced heap.  
   Either firstAllocatedPage and lastAllocatedPages are equal to
   InvalidPage and no pages are allocated; or both are valid pages
   and page p is allocated iff

          firstAllocatedPage <= p <= lastAllocatedPage
      AND space [p-firstAllocatedPage] != Unallocated

   NUMBER (space) must be equal to lastAllocatedPage -
   firstAllocatedPage + 1 if there are
   allocated pages. Index i in space correspond to page i + firstAllocatedPage; 
   that is firstAllocatedPage is the number of the first page
   available in space, and it must be in
   [firstAllocatedPage .. firstAllocatedPage] if there are
   allocated pages.


   The range of space is [Unallocated..MaxSpace] where MaxSpace is large
   enough to ensure that the freepage index completely sweeps all of memory
   before a space identifier is ever resused. *)


(* When we detect that a page may contain roots, we insert it
  in a global queue. Here we know that the page is allocated, so there
  is no need to check that.  This queue is represented by the globals
  queueHead and queueTail (the number of first and last page of the
  queue respectively), and by the array link.

  The array link is synchronized with the array space. *)

VAR
  queueHead, queueTail: Page;

(* If a page is allocated, its type can be PageType.Header or
   PageType.Continued. In the first case, there is a heap object just at the
   beginning of the page and others following. The second case occurs
   when a heap object was too large to fit on the rest of a page: it starts
   somewhere on an PageType.Header page (following some other
   heap objects entirely contained on this page) and overflows on contiguous
   PageType.Continued pages. Whatever space is left on the last
   PageType.Continued page is never used. In other words, all the headers
   are on PageType.Header pages; it may happen that the header
   starts near the end of a PageType.Header page and that the
   referent is on the following page.

   The array types is synchronized with the array space (same range
   and same page <-> index mapping).

   Actually, heap objects do not need to be contiguous. Indeed,
   alignment constraints would make it difficult to ensure that property.
   <* description of fillers*> *)




CONST
  InvalidPage = 0;
 
TYPE
  Page = [0 .. Word.Divide (-1, BytesPerPage)];

  Type = { Header, Continued };
  Space = { Unallocated, Current, New, Free };
  Promotion = { AmbiguousRoot, Large, ContainsFrozenRef, 
                ContainsAccessibleFrozenRef, Allocated };


  Desc = RECORD 
           space:    BITS  2 FOR Space;
           type:     BITS  1 FOR Type;
           promoted: BITS  3 FOR Promotion;
           link:     BITS 26 FOR Page; END;


VAR
  firstAllocatedPage,
  lastAllocatedPage   : Page := InvalidPage;
  desc: UNTRACED REF ARRAY OF Desc;
  collections := 0;
  
END RTHeapRep.