runtime/src/common/RTHeapRep.m3


Copyright (C) 1994, Digital Equipment Corp.

UNSAFE MODULE RTHeapRep;

IMPORT RT0u, RTType, RTMisc;
----------------------------------------------------------- open arrays ---

PROCEDURE UnsafeGetShape (r: REFANY;  VAR nDims: INTEGER;  VAR s: ArrayShape) =
  VAR def := RTType.Get (TYPECODE (r));
  BEGIN
    nDims := def.nDimensions;
    IF nDims # 0 THEN
      s := LOOPHOLE(LOOPHOLE(r, ADDRESS) + ADRSIZE(ADDRESS), ArrayShape);
    END;
  END UnsafeGetShape;
-------------------------------------------------------------- monitors ---

TYPE
  PublicMonitorClosure = OBJECT
                         METHODS
                           before ();
                           after  ();
                         END;

REVEAL
  MonitorClosure =
    PublicMonitorClosure BRANDED "RTHeap.MonitorClosure" OBJECT
      next, prev: MonitorClosure;
    OVERRIDES
      before := Noop;
      after  := Noop;
    END;

VAR monitorsHead, monitorsTail: MonitorClosure;

PROCEDURE InvokeMonitors (before: BOOLEAN) =
  VAR m: MonitorClosure;
  BEGIN
    IF before THEN
      m := monitorsHead;
      WHILE m # NIL DO m.before(); m := m.next; END;
    ELSE
      m := monitorsTail;
      WHILE m # NIL DO m.after(); m := m.prev; END;
    END;
  END InvokeMonitors;

PROCEDURE RegisterMonitor (cl: MonitorClosure) =
  BEGIN
    cl.next := monitorsHead;
    IF monitorsHead = NIL THEN
      monitorsTail := cl;
    ELSE
      monitorsHead.prev := cl;
    END;
    monitorsHead := cl;
  END RegisterMonitor;

PROCEDURE UnregisterMonitor (cl: MonitorClosure) =
  BEGIN
    IF cl = monitorsHead THEN
      IF cl = monitorsTail THEN
        monitorsHead := NIL;
        monitorsTail := NIL;
      ELSE
        monitorsHead := monitorsHead.next;
        monitorsHead.prev := NIL;
      END;
    ELSE
      IF cl = monitorsTail THEN
        monitorsTail := monitorsTail.prev;
        monitorsTail.next := NIL;
      ELSE
        cl.prev.next := cl.next;
        cl.next.prev := cl.prev;
      END;
    END;
  END UnregisterMonitor;

PROCEDURE Noop (<*UNUSED*> cl: MonitorClosure) =
  BEGIN
  END Noop;
-------------------------------------------------------- initialization ---

PROCEDURE CheckTypes () =
  (* called by RTType.Init after type registration, but before any
     allocation *)
  VAR
    is_power: ARRAY [0 .. 8] OF BOOLEAN;
    size    : INTEGER;
  BEGIN
    (* check that it's safe to eliminate the #A call to upper ... *)
    FOR i := 0 TO RT0u.nTypes - 1 DO
      WITH def = RTType.Get (i)^ DO
        IF (def.traced # 0) AND (def.nDimensions = 0) THEN
          size := def.dataSize;
          <*ASSERT size = RTMisc.Upper (size, BYTESIZE (Header)) *>
        END;
      END;
    END;

    (* compute the small powers of two *)
    FOR i := FIRST(is_power) TO LAST(is_power) DO is_power[i] := FALSE END;
    is_power[1] := TRUE;
    is_power[2] := TRUE;
    is_power[4] := TRUE;
    is_power[8] := TRUE;

    (* check that all data alignments are small powers of two so that
       "RTMisc.Align (addr, alignment)" can be safely replaced by "addr +
       align [Word.And (addr, 7), alignment]" in Gcalloc.*)
    FOR i := 0 TO RT0u.nTypes - 1 DO
      WITH def = RTType.Get (i)^ DO
        IF (def.traced # 0) THEN
          <*ASSERT is_power [def.dataAlignment] *>
        END;
      END;
    END;
  END CheckTypes;

BEGIN
END RTHeapRep.

interface RT0u is in: