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

    :Program.    TaskMemory.mod
    :Contents.   Allocation procedures using the Task.memEntry-list
    :Author.     Nicolas Benezan [bne]
    :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
    :Phone.      711/333679
    :Copyright.  Public Domain
    :Language.   Modula-2
    :Translator. M2Amiga AMSoft 3.2d
    :History.    V1.0b [bne] 27.Jan.1989 (extracted from MemSystem1.1)
    :History.    V1.1 [bne] 29.Mar.1989 (supports MemSystem1.3, Levels)
    :History.    V1.2 [bne] 24.Jun.1989 (performance improved)
    :Bugs.       does not handle Arts-levels perfectly if CLI-started
    :Bugs.       (however, no serious malfunctions should occur)

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

IMPLEMENTATION MODULE TaskMemory;

FROM SYSTEM     IMPORT ADR, ADDRESS, CAST;
FROM Exec       IMPORT MemReqSet, MemReqs, TaskPtr, FindTask, NodePtr,
                AddHead, Remove, AllocEntry, FreeEntry, MemList, MemEntry,
                MemListPtr, Byte;
FROM Arts       IMPORT TermProcedure, wbStarted, CurrentLevel;

CONST   ThisTask=NIL;
        NodeName="TaskMemEntry";

TYPE    TaskMemEntry=RECORD
          memList:MemList;
          memEntry:MemEntry;
        END;
        TaskMemEntryPtr=POINTER TO TaskMemEntry;
        TaskMemEntryPtrPtr=POINTER TO TaskMemEntryPtr;

PROCEDURE AllocTaskMem(byteSize:LONGINT;requirements:MemReqSet):ADDRESS;
VAR     Task:TaskPtr;
        Entry:TaskMemEntry;
        EntryPtr:TaskMemEntryPtr;
        FirstAdr:TaskMemEntryPtrPtr;

BEGIN
  WITH Entry DO
    memList.numEntries:=1;
    memEntry.reqs:=requirements;
    memEntry.length:=byteSize+4;
  END;
  EntryPtr:=ADDRESS(AllocEntry(ADR(Entry)));
  IF LONGINT(EntryPtr)<0 THEN
    RETURN NIL;
  ELSE
    Task:=FindTask(ThisTask);
    WITH EntryPtr^.memList.node DO
      name:=ADR(NodeName);
      pri:=CAST(Byte,Task^.memEntry.pad);
    END;
    AddHead(ADR(Task^.memEntry),ADDRESS(EntryPtr));
    FirstAdr:=EntryPtr^.memEntry.addr;
    FirstAdr^:=EntryPtr;
    INC(FirstAdr,4);
    RETURN FirstAdr;
  END;
END AllocTaskMem;

PROCEDURE DeallocTaskMem(VAR Pointer:ADDRESS);
VAR     EntryPtr:TaskMemEntryPtr;
        FirstAdr:TaskMemEntryPtrPtr;
BEGIN
  FirstAdr:=ADDRESS(LONGINT(Pointer)-4);
  EntryPtr:=FirstAdr^;
  (* this assumes that the MemEntry-list is not corrupt !!! *)
  (* otherwise guru is likely to occur *)
  Remove(ADDRESS(EntryPtr));
  FreeEntry(ADDRESS(EntryPtr));
  Pointer:=NIL;
END DeallocTaskMem;

(*нннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннн*)
(* The following procedures are included to be compatible with Heap     *)
(*нннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннн*)

PROCEDURE AllocMem(VAR adr:ADDRESS;size:LONGINT;chipMem:BOOLEAN);
BEGIN
  IF chipMem THEN
    adr:=AllocTaskMem(size,CHIP);
  ELSE
    adr:=AllocTaskMem(size,ANY);
  END;
END AllocMem;

PROCEDURE Allocate(VAR adr:ADDRESS;size:LONGINT);
BEGIN
  adr:=AllocTaskMem(size,ANY);
END Allocate;

PROCEDURE Deallocate(VAR adr:ADDRESS);
BEGIN
  DeallocTaskMem(adr);(* tell me why m2cV3.11 can't alias *)
END Deallocate;

(*нннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннн*)
(* Free the entries we added to the memEntry-list of a CLI              *)
(* (because the CLI-Task is not RemTask()ed when we exit)               *)
(*нннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннн*)
PROCEDURE CleanupCliHeap;
VAR     Task:TaskPtr;
        EntryPtr,NextEntryPtr:TaskMemEntryPtr;
BEGIN
  IF CurrentLevel()<=0 THEN
    Task:=FindTask(ThisTask);
    EntryPtr:=ADDRESS(Task^.memEntry.head);
    LOOP
      NextEntryPtr:=ADDRESS(EntryPtr^.memList.node.succ);
      IF NextEntryPtr=NIL THEN
        EXIT
      END;
      IF EntryPtr^.memList.node.name=ADR(NodeName) THEN
        (* if it is ours *)
        Remove(ADDRESS(EntryPtr));
        FreeEntry(ADDRESS(EntryPtr));
      END;
      EntryPtr:=NextEntryPtr;
    END;
  END;
END CleanupCliHeap;

BEGIN
  IF NOT wbStarted THEN
    TermProcedure(CleanupCliHeap);
  END;
END TaskMemory.