Fresh Fish 9/FreshFishVol9-CD1.bin/useful/dev/obero/oberon-a/source/amiga/execsupport.mod

Text File | 1995-01-26 | 6.5 KB | 261 lines

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

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

   Created by: fjc (Frank Copeland)
    $Revision: 3.2 $
      $Author: fjc $
        $Date: 1995/01/26 02:39:55 $

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

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

<* STANDARD- *> <* INITIALISE- *> <* MAIN- *>
<*$ CaseChk-  IndexChk- LongVars+ NilChk-  *>
<*$ RangeChk- StackChk- TypeChk-  OvflChk- *>

MODULE ExecSupport;

IMPORT SYS := SYSTEM, Kernel, e := Exec, s := Sets;

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

(*------------------------------------*)
PROCEDURE NewMinList*(VAR list: e.MinList);
(*
 * obsolete -- use NewList() instead!
 *)
BEGIN
  list.head := SYS.ADR(list.tail);
  list.tail := NIL;
  list.tailPred := SYS.ADR(list.head);
END NewMinList;


(*------------------------------------*)
PROCEDURE MinListEmpty*(VAR list : e.MinList): BOOLEAN;
(*
 * obsolete -- use ListEmpty() instead!
 *)
BEGIN
  RETURN list.tailPred = SYS.ADR(list);
END MinListEmpty;


(*------------------------------------*)
PROCEDURE NewList* (VAR list : e.CommonList);
BEGIN (* NewList *)
  NewMinList (SYS.VAL (e.MinList, list))
END NewList;


(*------------------------------------*)
PROCEDURE ListEmpty*(VAR list : e.CommonList): BOOLEAN;
BEGIN
  RETURN ListEmpty (SYS.VAL (e.MinList, list))
END ListEmpty;


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


(*------------------------------------*)
PROCEDURE IsMsgPortEmpty * (x : e.MsgPortBasePtr) : BOOLEAN;
  VAR mp : e.MsgPortPtr;
BEGIN
  mp := SYS.VAL (e.MsgPortPtr, x);
  RETURN mp.msgList.tailPred = SYS.VAL (e.NodePtr, mp);
END IsMsgPortEmpty;


(*------------------------------------*)
<*$CopyArrays-*>
PROCEDURE CreatePort * (portName : ARRAY OF CHAR; priority : SHORTINT)
  : e.MsgPortPtr;

  VAR sigBit : SHORTINT; mp : e.MsgPortPtr; name : e.LSTRPTR;

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

  Kernel.Allocate (mp, SIZE (e.MsgPort), {e.public, e.clear});
  IF mp = NIL THEN e.FreeSignal (sigBit); RETURN NIL END;

  IF portName = "" THEN name := NIL ELSE name := SYS.ADR (portName) END;
  mp.node.name := name;
  mp.node.pri := priority;
  mp.node.type := e.msgPort;
  mp.flags := e.signal;
  mp.sigBit := sigBit;
  mp.sigTask := e.FindTask (e.NILSTR); (* Find THIS task. *)

  IF name # NIL THEN e.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.node.name # NIL THEN e.RemPort (mp) END;

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

  e.FreeSignal (mp.sigBit);
  SYS.DISPOSE (mp)
END DeletePort;

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


(*------------------------------------*)
PROCEDURE BeginIO * ( ioReq : e.IORequestBasePtr );

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


(*------------------------------------*)
PROCEDURE AbortIO* ( ioReq : e.IORequestBasePtr );
(*
 * obsolete -- prefer to use Exec.AbortIO
 *)
BEGIN
  SYS.PUTREG (9, ioReq); (* MOVE.L  ioReq(A5), A1 *)
  SYS.INLINE (
    2C69H, 20   ,        (* MOVE.L  20(A1), A6    *)
    4EAEH, -36 )         (* JSR     -36(A6)       *)
END AbortIO;


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

  VAR ioReq : e.IORequestPtr;

BEGIN (* CreateExtIO *)
  IF port = NIL THEN RETURN NIL END;
  Kernel.Allocate (ioReq, ioSize, {e.public, e.clear});
  IF ioReq # NIL THEN
    ioReq.message.node.type := e.replyMsg;
    ioReq.message.length := ioSize;
    ioReq.message.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.message.node.succ := SYS.VAL (e.NodePtr, -1);
    req.message.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;

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

  VAR
    taskMemList : RECORD [2] (e.Node)
      numEntries : INTEGER;
      entries : ARRAY 2 OF RECORD [2]
        reqs : s.SET32;
        size : LONGINT;
      END;
    END;
    memList : POINTER [2] TO RECORD [2] (e.MemList)
      entries : ARRAY 2 OF e.MemEntry;
    END;
    newTask : e.TaskPtr;

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

  newTask := memList.entries[0].addr;
  newTask.node.type := e.task;
  newTask.node.pri := pri;
  newTask.node.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.AddHead (newTask.memEntry, memList);
  e.AddTask (newTask, initPC, NIL);
  RETURN newTask
END CreateTask;

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

BEGIN (* DeleteTask *)
  e.RemTask (task)
END DeleteTask;

END ExecSupport.