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

     $RCSfile: ExecUtil.mod $
  Description: Support for clients of exec.library

   Created by: fjc (Frank Copeland)
    $Revision: 1.2 $
      $Author: fjc $
        $Date: 1994/05/12 19:42:31 $

  Copyright © 1994, Frank Copeland.
  This file is part of the Oberon-A Library.
  See Oberon-A.doc for conditions of use and distribution.

  Log entries are at the end of the file.

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

MODULE ExecUtil;

(* $L+ use absolute long addressing for global variables *)

IMPORT T := Types, E := Exec, SYS := SYSTEM;

TYPE

  CompareProc * = PROCEDURE ( VAR n1, n2 : E.MinNode ) : INTEGER;


(*--------------------------------------------------------------------*)
(*
  Exec List handling procedures
*)


(*------------------------------------*)
PROCEDURE GetSucc * ( node : E.MinNodePtr ) : E.MinNodePtr;

BEGIN (* GetSucc *)
  IF node # NIL THEN
    node := node.lnSucc; IF node.lnSucc = NIL THEN node := NIL END
  END; (* IF *)
  RETURN node;
END GetSucc;


(*------------------------------------*)
PROCEDURE GetPred * ( node : E.MinNodePtr ) : E.MinNodePtr;

BEGIN (* GetPred *)
  IF node # NIL THEN
    node := node.lnPred; IF node.lnPred = NIL THEN node := NIL END
  END; (* IF *)
  RETURN node;
END GetPred;


(*------------------------------------*)
PROCEDURE GetHead * ( VAR list : E.MinList ) : E.MinNodePtr;

VAR node : E.MinNodePtr;

BEGIN (* GetHead *)
  node := list.lhHead; IF node.lnSucc = NIL THEN node := NIL END;
  RETURN node;
END GetHead;


(*------------------------------------*)
PROCEDURE GetTail * ( VAR list : E.MinList ) : E.MinNodePtr;

VAR node : E.MinNodePtr;

BEGIN (* GetTail *)
  node := list.lhTailPred; IF node.lnPred = NIL THEN node := NIL END;
  RETURN node;
END GetTail;


(*------------------------------------*)
PROCEDURE ListLength * ( VAR list : E.MinList ) : LONGINT;

VAR node : E.MinNodePtr; count : LONGINT;

BEGIN (* ListLength *)
  count := 0; node := list.lhHead;
  WHILE node.lnSucc # NIL DO INC (count); node := node.lnSucc END;
  RETURN count;
END ListLength;


(*------------------------------------*)
PROCEDURE NodeAt * ( VAR list : E.MinList; pos : LONGINT )
  : E.MinNodePtr;

VAR node : E.MinNodePtr; count : LONGINT;

BEGIN (* NodeAt *)
  count := pos; node := list.lhHead;
  WHILE (node.lnSucc # NIL) & (count > 0) DO
    DEC( count ); node := node.lnSucc;
  END;
  IF node.lnSucc = NIL THEN node := NIL END;
  RETURN node;
END NodeAt;


(*------------------------------------*)
PROCEDURE InsertAt *
  ( VAR list : E.MinList; VAR node : E.MinNode; pos : LONGINT );

VAR oldNode : E.MinNodePtr;

BEGIN (* InsertAt *)
  oldNode := NodeAt (list, pos);
  IF oldNode = NIL THEN E.Base.AddTail (list, node);
  ELSE                  E.Base.Insert (list, node, oldNode.lnPred);
  END; (* ELSE *)
END InsertAt;


(*------------------------------------*)
PROCEDURE InsertOrdered *
  ( VAR list : E.MinList; VAR node : E.MinNode; Compare : CompareProc )
  : LONGINT;

VAR prevNode, nextNode : E.MinNodePtr; position : LONGINT;

BEGIN (* InsertOrdered *)
  position := 0; prevNode := NIL; nextNode := GetHead (list);
  WHILE (nextNode # NIL) & (Compare (node, nextNode^) >= 0) DO
    prevNode := nextNode; nextNode := GetSucc (nextNode);
    INC (position)
  END; (* WHILE *)
  E.Base.Insert (list, node, prevNode);
  RETURN position;
END InsertOrdered;


(*------------------------------------*)
PROCEDURE RemoveAt * ( VAR list : E.MinList; pos : LONGINT )
  : E.MinNodePtr;

VAR node : E.MinNodePtr;

BEGIN (* RemoveAt *)
  node := NodeAt( list, pos );
  IF node # NIL THEN E.Base.Remove (node^) END;
  RETURN node;
END RemoveAt;


(*--------------------------------------------------------------------*)
(*
  Exec MessagePort procedures.
*)


(*------------------------------------*)
PROCEDURE CreatePort * (name : T.STRPTR; priority : SHORTINT)
  : E.MsgPortPtr;

  VAR sigBit : SHORTINT; mp : E.MsgPortPtr;

BEGIN (* CreatePort *)
  sigBit := E.Base.AllocSignal (-1);
  IF sigBit = -1 THEN RETURN NIL END;

  mp := E.Base.AllocMem (SIZE (E.MsgPort), {E.memPublic, E.memClear});
  IF mp = NIL THEN E.Base.FreeSignal (sigBit); RETURN NIL END;

  mp.lnName := name;
  mp.lnPri := priority;
  mp.lnType := E.ntMsgPort;
  mp.mpFlags := {E.paSignal};
  mp.mpSigBit := sigBit;
  mp.mpSigTask := E.Base.FindTask (NIL); (* Find THIS task. *)

  IF name # NIL THEN E.Base.AddPort (mp^)
  ELSE E.NewList (mp.mpMsgList)
  END; (* ELSE *)

  RETURN mp
END CreatePort;

(*------------------------------------*)
PROCEDURE DeletePort * (mp : E.MsgPortPtr);

BEGIN (* DeletePort *)
  (* if it was public ... *)

  IF mp.lnName # NIL THEN E.Base.RemPort (mp^) END;

  (* make it difficult to re-use the port *)

  mp.mpSigTask := SYS.VAL (E.TaskPtr, -1);
  mp.mpMsgList.lhHead := SYS.VAL (E.MinNodePtr, -1);

  E.Base.FreeSignal (SYS.VAL (SHORTINT, mp.mpSigBit));
  E.Base.FreeMem (mp, SIZE (E.MsgPort));
END DeletePort;

END ExecUtil.

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

  $Log: ExecUtil.mod $
# Revision 1.2  1994/05/12  19:42:31  fjc
# - Prepared for release
#
  Revision 1.1  1994/01/15  17:56:57  fjc
  - Start of revision control

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