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

(* Last modified on Tue Dec 29 13:01:20 PST 1992 by jdd *)
(* 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.  Some items here should be made private or moved
   elsewhere. *)

IMPORT RT0, RTHeapDep;
FROM RT0 IMPORT Typecode;

(* The allocator and collector maintain two heaps of objects.  One heap is
   "traced" (its objects are collected); the other is "untraced".

   The allocator for the untraced heap is simply "malloc".  Unless
   explicitly noted, all procedures and variables here are for the traced
   heap.  Unless explicitly noted, none of the variables in this interface
   are writable. *)

(****** PAGES ******)

(* The (traced) heap consists of a number of aligned pages, divided among
   three spaces: Free, Previous, and Current.  All other pages in the
   address space are in the "Unallocated" space.  Pages are numbered 0, 1,
   2, ....  The pagesize used is fixed; if incremental or generational
   collection is to be allowed, it must be at least the VM page size.

   The global variable p0 and p1 note the bounds of the heap pages: only
   pages in the range [p0, p1) are in a space other than Unallocated.  For
   these pages, the array "desc" holds more information; desc[p - p0] holds
   state for page "p". *)

CONST
  BytesPerPage    = RTHeapDep.BytesPerPage;
  LogBytesPerPage = RTHeapDep.LogBytesPerPage;
  AdrPerPage      = RTHeapDep.AdrPerPage;
  LogAdrPerPage   = RTHeapDep.LogAdrPerPage;

TYPE Page = RTHeapDep.Page;

CONST
  Nil: Page = 0;                 (* page 0 cannot be part of the traced
                                    heap *)

VAR p0, p1: Page := Nil;

VAR desc: UNTRACED REF ARRAY OF Desc;

TYPE
  Desc = RECORD
           space     : BITS 2 FOR Space;
           generation: BITS 1 FOR Generation;
           pure      : BITS 1 FOR BOOLEAN;
           note      : BITS 3 FOR Note;
           gray      : BITS 1 FOR BOOLEAN;
           protected : BITS 1 FOR BOOLEAN;
           continued : BITS 1 FOR BOOLEAN;
           link: BITS BITSIZE(ADDRESS) - LogAdrPerPage FOR Page := Nil;
         END;

TYPE Space = {Unallocated, Free, Previous, Current};

(* Each page has a short note attached, describing why it is in its current
   state.  This is usually used for performance monitoring. *)

TYPE
  Note = {OlderGeneration,       (* page promoted to current space because
                                    it it contained the older generation
                                    from the previous space *)
          AmbiguousRoot,         (* page promoted to current space because
                                    of a possible reference from a thread
                                    state *)
          Large,                 (* page promoted to current space because
                                    it contains a single accessible object,
                                    so no garbage would be collected by
                                    copying the object *)
          Frozen,                (* page contains frozen ref *)
          Allocated,             (* page was allocated in current space *)
          Copied};               (* page contains elements that were copied
                                    from previous space *)

(* The collector can be generational; the heap is divided into two
   generations. *)

TYPE Generation = {Older, Younger};

VAR
  allocatedPages: CARDINAL := 0; (* the number of pages in the Free,
                                    Previous, or Current spaces *)

PROCEDURE AllocatePages (n: INTEGER): ADDRESS;
(* backdoor into allocator: allocate n pages, but leave them in the
   Unallocated space *)

PROCEDURE MakeCollectible (adr: ADDRESS; cnt: INTEGER);
(* backdoor into allocator; take the pages allocated by AllocatePages, and
   accept them into the heap.  Various conditions must be satisfied by the
   caller. *)

(****** HEAP OBJECTS ******)

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

   "Small" objects never cross a page boundary.  "Large" objects are larger
   than a page; they span multiple contiguous pages.  For large objects,
   pages following the first are marked "continued".  The large object is
   the only object on its pages; it starts at the beginning of its first
   page, and no other objects follow it on its last page.

   Special "filler" objects are used to exactly fill out the end of a page
   of small objects, or to fill space between small objects when they
   cannot exactly follow the previous object because of alignment
   restrictions.  There are 1-word and multi-word filler objects.  The
   beginning of a page is always adequate alignment, so a filler object
   need never begin a page. *)

TYPE Header = RT0.RefHeader;

CONST
  Fill_1_type: Typecode = LAST(Typecode); (* 1 word filler *)
  FillHeader1: Header = Header{typecode := Fill_1_type, forwarded := FALSE};

CONST
  Fill_N_type: Typecode = LAST(Typecode) - 1; (* multi-word filler, the
                                                 second word is the total
                                                 size of the object, in
                                                 bytes *)
  FillHeaderN: Header = Header{typecode := Fill_N_type, forwarded := FALSE};

PROCEDURE GetSize (r: REFANY): INTEGER;
(* returns the size in bytes of the object r, including r's header *)

(****** OPEN ARRAYS ******)

(* An open array object with N open dimensions contains a header, then a
   pointer to the first data element, then N integers that hold the
   dimensions. *)

TYPE
  OpenArrayInfo = RECORD
                    data: ADDRESS;  (* The REF points here *)
                    shape: ARRAY [0 .. (*N-1*) 99999] OF CARDINAL;
                  END;

PROCEDURE UnsafeGetShape (    r          : REFANY;
                          VAR nDimensions: INTEGER;
                          VAR s: UNTRACED REF ARRAY [0 .. 999] OF INTEGER);
(* if r is a reference to an open array, the number of open dimensions,
   nDimensions, and size of each dimension, s, is returned.  The array's
   shape vector is valid as long as r exists.  If r is not a reference to
   an open array, nDimensions = 0 and s is undefined.  It is an unchecked
   runtime error to modify s^, to free s, or to use it after r has been
   garbage collected. *)

(****** MODULE 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 in the object's body *)

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

(****** ALLOCATION ******)

(* Most entry points are in RTHeap; I have no idea why this one is here. *)

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

(****** DEALLOCATION ******)

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 *)

(****** COLLECTOR STATUS AND CONTROL ******)

(* There are various mechanisms for interacting with the collector. *)

VAR collections := 0;            (* the number of collections begun *)

VAR gcOff: CARDINAL := 0;        (* collector can run iff gcOff = 0 *)

VAR
  vmOff: CARDINAL := 0;          (* collector can use VM protection iff
                                    vmOff = 0 *)

PROCEDURE Crash (): BOOLEAN;     (* called by the runtime when the program
                                    is about to crash.  completes current
                                    collection and won't start another.
                                    the heap is readable when it returns;
                                    if it returns TRUE, the collection
                                    successfully completed. *)

(* We maintain counts of pages in the current pace allocated by "NEW", by
   copying, and by promotion, for pages for small objects and for large
   objects. *)

VAR
  smallNewPages, largeNewPages            : CARDINAL := 0;
  smallCopyPages, largeCopyPages          : CARDINAL := 0;
  smallPromotionPages, largePromotionPages: CARDINAL := 0;

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

PROCEDURE RegisterMonitor (cl: MonitorClosure);
(* Before each collection, the collector calls all registered 'before'
   procedures; after each collection, the collector calls all registered
   'after' procedures. *)

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

(****** VM ******)

(****** DEBUGGING ******)

(* There are various routines for collecting or printing out information on
   the objects on the heap. *)

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); (* print various information *)

(****** INITIALIZATION ******)

PROCEDURE CheckTypes ();
(* called after type registration to let the allocator sanity check the
   typecells. *)

END RTHeapRep.