Fresh Fish 8/FreshFishVol8-CD1.bin/useful/dev/obero/oberon-a/source/amigautil/executil.mod

Text File | 1994-09-03 | 8.2 KB | 342 lines

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

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

   Created by: fjc (Frank Copeland)
    $Revision: 3.3 $
      $Author: fjc $
        $Date: 1994/09/03 16:07:32 $

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

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

MODULE ExecUtil;

(*
** $C- CaseChk       $I- IndexChk  $L+ LongAdr   $N- NilChk
** $P- PortableCode  $R- RangeChk  $S- StackChk  $T- TypeChk
** $V- OvflChk       $Z- ZeroVars
*)

IMPORT
  SYS := SYSTEM,
  Kernel,
  E := Exec;

TYPE

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


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


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

BEGIN (* NewList *)
  list.head := SYS.ADR (list.tail);
  list.tail := NIL;
  list.tailPred := SYS.ADR (list.head)
END NewList;


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

BEGIN (* GetSucc *)
  IF node # NIL THEN
    node := node.succ; IF node.succ = 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.pred; IF node.pred = 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.head; IF node.succ = 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.tailPred; IF node.pred = 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.head;
  WHILE node.succ # NIL DO INC (count); node := node.succ 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.head;
  IF node # NIL THEN
    WHILE (node.succ # NIL) & (count > 0) DO
      DEC( count ); node := node.succ;
    END;
    IF node.succ = NIL THEN node := NIL END
  END;
  RETURN node
END NodeAt;


(*------------------------------------*)
PROCEDURE InsertAt *
  ( VAR list : E.MinList; node : E.MinNodePtr; 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.pred)
  END
END InsertAt;


(*------------------------------------*)
PROCEDURE InsertOrdered *
  ( VAR list : E.MinList; node : E.MinNodePtr; 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;
  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.
*)


(*------------------------------------*)
(*$D-*)
PROCEDURE CreatePort * (portName : ARRAY OF CHAR; priority : SHORTINT)
  : E.MsgPortPtr;

  VAR sigBit : SHORTINT; mp : E.MsgPortPtr; name : E.STRPTR;

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

  Kernel.New (mp, SIZE (E.MsgPort), {E.memPublic, E.memClear});
  IF mp = NIL THEN E.base.FreeSignal (sigBit); RETURN NIL END;

  IF portName = "" THEN name := NIL ELSE name := SYS.ADR (portName) END;
  mp.name := name;
  mp.pri := priority;
  mp.type := E.ntMsgPort;
  mp.mpFlags := E.paSignal;
  mp.sigBit := sigBit;
  mp.sigTask := E.base.FindTask (NIL); (* Find THIS task. *)

  IF name # NIL THEN E.base.AddPort (mp)
  ELSE NewList (mp.msgList)
  END;

  RETURN mp
END CreatePort;

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

BEGIN (* DeletePort *)
  IF mp = NIL THEN RETURN END;

  (* if it was public ... *)
  IF mp.name # NIL THEN E.base.RemPort (mp) END;

  (* make it difficult to re-use the port *)
  mp.sigTask := SYS.VAL (E.TaskPtr, -1);
  mp.msgList.head := SYS.VAL (E.MinNodePtr, -1);

  E.base.FreeSignal (mp.sigBit);
  SYS.DISPOSE (mp)
END DeletePort;

(*--------------------------------------------------------------------*)
(*
  Exec IO procedures.
*)


(*------------------------------------*)
PROCEDURE BeginIO * ( ioReq : E.IORequestPtr );

BEGIN (* BeginIO *)
  SYS.PUTREG (9, ioReq); (* MOVE.L  ioReq(A5), A1 *)
  SYS.INLINE (
    2C69H, 0014H,        (* MOVE.L  0014(A1), A6  *)
    4EAEH, -001EH );     (* JSR     FFE2(A6)      *)
END BeginIO;

(*------------------------------------*)
PROCEDURE CreateExtIO *
  ( port   : E.MsgPortPtr;
    ioSize : INTEGER )
  : E.APTR;

  VAR ioReq : E.IORequestPtr;

BEGIN (* CreateExtIO *)
  IF port = NIL THEN RETURN NIL END;
  Kernel.New (ioReq, ioSize, {E.memPublic, E.memClear});
  IF ioReq # NIL THEN
    ioReq.type := E.ntReplyMsg;
    ioReq.mnLength := ioSize;
    ioReq.replyPort := port
  END;
  RETURN ioReq
END CreateExtIO;

(*------------------------------------*)
PROCEDURE DeleteExtIO ( ioReq : E.APTR );

  VAR req : E.IORequestPtr;

BEGIN (* DeleteExtIO *)
  IF ioReq # NIL THEN
    req := ioReq;
    req.succ := SYS.VAL (E.MinNodePtr, -1);
    req.replyPort := SYS.VAL (E.MsgPortPtr, -1);
    SYS.DISPOSE (req)
  END
END DeleteExtIO;

(*------------------------------------*)
PROCEDURE CreateStdIO* ( port : E.MsgPortPtr ) : E.IOStdReqPtr;

BEGIN (* CreateStdIO *)
  RETURN CreateExtIO (port, SIZE (E.IOStdReq))
END CreateStdIO;

(*------------------------------------*)
PROCEDURE DeleteStdIO* ( ioReq : E.IOStdReqPtr );

BEGIN (* DeleteStdIO *)
  DeleteExtIO (ioReq)
END DeleteStdIO;

END ExecUtil.

(*------------------------------------*)
PROCEDURE CreateTask *
  ( name      : ARRAY OF CHAR;
    pri       : SHORTINT;
    initPC    : E.PROC;
    stackSize : ULONG )
  : E.TaskPtr;

  VAR
    taskMemList : RECORD (E.Node)
      numEntries : INTEGER;
      entries : ARRAY 2 OF RECORD
        reqs : SET;
        size : LONGINT;
      END;
    END;
    memList : CPOINTER TO RECORD (E.MemList)
      entries : ARRAY 2 OF E.MemEntry;
    END;
    newTask : E.TaskPtr;

BEGIN (* CreateTask *)
  stackSize := SYS.AND (stackSize + 3, 0FFFFFFFCH);
  taskMemList.type := E.ntUnknown;
  taskMemList.pri := 0;
  taskMemList.name := NIL;
  taskMemList.numEntries := 2;
  taskMemList.entries[0].reqs := {E.memPublic, E.memClear};
  taskMemList.entries[0].size := SIZE (E.Task);
  taskMemList.entries[1].reqs := {E.memClear};
  taskMemList.entries[1].size := stackSize;
  memList := E.base.AllocEntry (SYS.ADR (taskMemList));
  IF 31 IN SYS.VAL (SET, memList) THEN RETURN NIL END;

  newTask := memList.entries[0].addr;
  newTask.type := E.ntTask;
  newTask.pri := pri;
  newTask.name := SYS.ADR (name);
  newTask.spLower := memList.entries[1].addr;
  newTask.spUpper :=
    SYS.VAL (E.APTR, SYS.VAL (LONGINT, newTask.spLower) + stackSize);
  newTask.spReg := newTask.spUpper;

  NewList (newTask.memEntry);
  E.base.AddHead (newTask.memEntry, memList);
  E.base.AddTask (newTask, initPC, NIL);
  RETURN newTask
END CreateTask;

(*------------------------------------*)
PROCEDURE DeleteTask * ( task : E.TaskPtr );

BEGIN (* DeleteTask *)
  E.base.RemTask (task)
END DeleteTask;