(*************************************************************************

:Program.    MultiMem.mod
:Contents.   Manages multible intepentend Memory-Heaps
:Author.     Hartmut Goebel
:Address.    Aufseßplatz 5, D-8500 Nürnberg 40
:Copyright.  Copyright © 1991 by Hartmut Goebel
:Copyright.  Freeware, feel free to Copy it, but let Copyright-note intact
:Language.   Oberon
:Translator. Amiga Oberon V2.00
:History.    V1.0, 02 Jun 1991, hartmut Goebel
:Date.       26 Aug 1991 18:52:06

:Support.    Fridjof Siebert (Mem-Handling in OberonLib)

*************************************************************************)

MODULE MultiMem;

IMPORT
  Exec, ol: OberonLib, sys: SYSTEM;

TYPE
  HeapPtr* = POINTER TO Heap;
  Heap = STRUCT (node: Exec.MinNode);
     list: Exec.MinList;
  END;

  MemElementPtr = POINTER TO MemElement;
  MemElement = STRUCT (node: Exec.MinNode);
    size: LONGINT; (* the hunk's size          *)
    mem: INTEGER;  (* and the actual hunk data *)
  END;

VAR
  HeapList: Exec.MinList;
  el1,el2: MemElementPtr;
  h1,h2: HeapPtr;

(* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)

PROCEDURE New*(heap: HeapPtr; VAR adr: LONGINT; size: LONGINT);
BEGIN
  INC(size,sys.SIZE(Exec.MinNode)+sys.SIZE(LONGINT));
  el1 := Exec.AllocMem(size,ol.MemReqs);
  IF el1=NIL THEN adr := NIL; RETURN END;
  el1.size := size;
  Exec.AddHead(heap.list,el1);
  adr := sys.ADR(el1.mem);
END New;


PROCEDURE Dispose*(VAR adr: LONGINT);
BEGIN
  IF adr#NIL THEN
    el1 := adr-(sys.SIZE(Exec.MinNode)+sys.SIZE(LONGINT));
    Exec.Remove(el1);
    Exec.FreeMem(el1,el1.size);
    adr := NIL;
  END;
END Dispose;


PROCEDURE NewHeap*(VAR heap: HeapPtr);
BEGIN
  heap := Exec.AllocMem(sys.SIZE(Heap),ol.MemReqs);
  IF heap#NIL THEN
    Exec.AddHead(HeapList,heap);
    heap.list.head     := sys.ADR(heap.list.tail);
    heap.list.tailPred := sys.ADR(heap.list.head);
    heap.list.tail     := NIL;
  END;
END NewHeap;


PROCEDURE EmptyHeap*(heap: HeapPtr);
BEGIN
  el1 := heap.list.head;
  LOOP
    el2 := el1.node.succ;
    IF el2=NIL THEN EXIT END;
    Exec.FreeMem(el1,el1.size);
    el1 := el2;
  END;
END EmptyHeap;


PROCEDURE DisposeHeap*(VAR heap: HeapPtr);
BEGIN
  IF heap#NIL THEN
    EmptyHeap(heap);
    Exec.Remove(heap);
    Exec.FreeMem(heap,sys.SIZE(Heap));
    heap := NIL;
  END;
END DisposeHeap;


BEGIN
  HeapList.head     := sys.ADR(HeapList.tail);
  HeapList.tailPred := sys.ADR(HeapList.head);
  HeapList.tail     := NIL;

CLOSE
  h1 := HeapList.head;
  LOOP
    h2 := h1.node.succ;
    IF h2=NIL THEN EXIT END;
    EmptyHeap(h1);
    Exec.FreeMem(h1,sys.SIZE(Heap));
    h1 := h2
  END;

END MultiMem.