home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 2 / goldfish_vol2_cd1.bin / files / dev / obero / oberon-a / source / amigautil / executil.mod < prev    next >
Text File  |  1994-09-03  |  8KB  |  342 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: ExecUtil.mod $
  4.   Description: Support for clients of exec.library
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 3.3 $
  8.       $Author: fjc $
  9.         $Date: 1994/09/03 16:07:32 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. ***************************************************************************)
  16.  
  17. MODULE ExecUtil;
  18.  
  19. (*
  20. ** $C- CaseChk       $I- IndexChk  $L+ LongAdr   $N- NilChk
  21. ** $P- PortableCode  $R- RangeChk  $S- StackChk  $T- TypeChk
  22. ** $V- OvflChk       $Z- ZeroVars
  23. *)
  24.  
  25. IMPORT
  26.   SYS := SYSTEM,
  27.   Kernel,
  28.   E := Exec;
  29.  
  30. TYPE
  31.  
  32.   CompareProc * = PROCEDURE ( n1, n2 : E.MinNodePtr ) : INTEGER;
  33.  
  34.  
  35. (*--------------------------------------------------------------------*)
  36. (*
  37.   Exec List handling procedures
  38. *)
  39.  
  40.  
  41. (*------------------------------------*)
  42. PROCEDURE NewList* (VAR list : E.MinList);
  43.  
  44. BEGIN (* NewList *)
  45.   list.head := SYS.ADR (list.tail);
  46.   list.tail := NIL;
  47.   list.tailPred := SYS.ADR (list.head)
  48. END NewList;
  49.  
  50.  
  51. (*------------------------------------*)
  52. PROCEDURE GetSucc * ( node : E.MinNodePtr ) : E.MinNodePtr;
  53.  
  54. BEGIN (* GetSucc *)
  55.   IF node # NIL THEN
  56.     node := node.succ; IF node.succ = NIL THEN node := NIL END
  57.   END; (* IF *)
  58.   RETURN node;
  59. END GetSucc;
  60.  
  61.  
  62. (*------------------------------------*)
  63. PROCEDURE GetPred * ( node : E.MinNodePtr ) : E.MinNodePtr;
  64.  
  65. BEGIN (* GetPred *)
  66.   IF node # NIL THEN
  67.     node := node.pred; IF node.pred = NIL THEN node := NIL END
  68.   END; (* IF *)
  69.   RETURN node;
  70. END GetPred;
  71.  
  72.  
  73. (*------------------------------------*)
  74. PROCEDURE GetHead * ( VAR list : E.MinList ) : E.MinNodePtr;
  75.  
  76. VAR node : E.MinNodePtr;
  77.  
  78. BEGIN (* GetHead *)
  79.   node := list.head; IF node.succ = NIL THEN node := NIL END;
  80.   RETURN node;
  81. END GetHead;
  82.  
  83.  
  84. (*------------------------------------*)
  85. PROCEDURE GetTail * ( VAR list : E.MinList ) : E.MinNodePtr;
  86.  
  87. VAR node : E.MinNodePtr;
  88.  
  89. BEGIN (* GetTail *)
  90.   node := list.tailPred; IF node.pred = NIL THEN node := NIL END;
  91.   RETURN node;
  92. END GetTail;
  93.  
  94.  
  95. (*------------------------------------*)
  96. PROCEDURE ListLength * ( VAR list : E.MinList ) : LONGINT;
  97.  
  98. VAR node : E.MinNodePtr; count : LONGINT;
  99.  
  100. BEGIN (* ListLength *)
  101.   count := 0; node := list.head;
  102.   WHILE node.succ # NIL DO INC (count); node := node.succ END;
  103.   RETURN count;
  104. END ListLength;
  105.  
  106.  
  107. (*------------------------------------*)
  108. PROCEDURE NodeAt * ( VAR list : E.MinList; pos : LONGINT )
  109.   : E.MinNodePtr;
  110.  
  111. VAR node : E.MinNodePtr; count : LONGINT;
  112.  
  113. BEGIN (* NodeAt *)
  114.   count := pos; node := list.head;
  115.   IF node # NIL THEN
  116.     WHILE (node.succ # NIL) & (count > 0) DO
  117.       DEC( count ); node := node.succ;
  118.     END;
  119.     IF node.succ = NIL THEN node := NIL END
  120.   END;
  121.   RETURN node
  122. END NodeAt;
  123.  
  124.  
  125. (*------------------------------------*)
  126. PROCEDURE InsertAt *
  127.   ( VAR list : E.MinList; node : E.MinNodePtr; pos : LONGINT );
  128.  
  129. VAR oldNode : E.MinNodePtr;
  130.  
  131. BEGIN (* InsertAt *)
  132.   oldNode := NodeAt (list, pos);
  133.   IF oldNode = NIL THEN E.base.AddTail (list, node)
  134.   ELSE E.base.Insert (list, node, oldNode.pred)
  135.   END
  136. END InsertAt;
  137.  
  138.  
  139. (*------------------------------------*)
  140. PROCEDURE InsertOrdered *
  141.   ( VAR list : E.MinList; node : E.MinNodePtr; Compare : CompareProc )
  142.   : LONGINT;
  143.  
  144. VAR prevNode, nextNode : E.MinNodePtr; position : LONGINT;
  145.  
  146. BEGIN (* InsertOrdered *)
  147.   position := 0; prevNode := NIL; nextNode := GetHead (list);
  148.   WHILE (nextNode # NIL) & (Compare (node, nextNode) >= 0) DO
  149.     prevNode := nextNode; nextNode := GetSucc (nextNode);
  150.     INC (position)
  151.   END;
  152.   E.base.Insert (list, node, prevNode);
  153.   RETURN position;
  154. END InsertOrdered;
  155.  
  156.  
  157. (*------------------------------------*)
  158. PROCEDURE RemoveAt * ( VAR list : E.MinList; pos : LONGINT )
  159.   : E.MinNodePtr;
  160.  
  161. VAR node : E.MinNodePtr;
  162.  
  163. BEGIN (* RemoveAt *)
  164.   node := NodeAt( list, pos );
  165.   IF node # NIL THEN E.base.Remove (node) END;
  166.   RETURN node;
  167. END RemoveAt;
  168.  
  169.  
  170. (*--------------------------------------------------------------------*)
  171. (*
  172.   Exec MessagePort procedures.
  173. *)
  174.  
  175.  
  176. (*------------------------------------*)
  177. (*$D-*)
  178. PROCEDURE CreatePort * (portName : ARRAY OF CHAR; priority : SHORTINT)
  179.   : E.MsgPortPtr;
  180.  
  181.   VAR sigBit : SHORTINT; mp : E.MsgPortPtr; name : E.STRPTR;
  182.  
  183. BEGIN (* CreatePort *)
  184.   sigBit := E.base.AllocSignal (-1);
  185.   IF sigBit = -1 THEN RETURN NIL END;
  186.  
  187.   Kernel.New (mp, SIZE (E.MsgPort), {E.memPublic, E.memClear});
  188.   IF mp = NIL THEN E.base.FreeSignal (sigBit); RETURN NIL END;
  189.  
  190.   IF portName = "" THEN name := NIL ELSE name := SYS.ADR (portName) END;
  191.   mp.name := name;
  192.   mp.pri := priority;
  193.   mp.type := E.ntMsgPort;
  194.   mp.mpFlags := E.paSignal;
  195.   mp.sigBit := sigBit;
  196.   mp.sigTask := E.base.FindTask (NIL); (* Find THIS task. *)
  197.  
  198.   IF name # NIL THEN E.base.AddPort (mp)
  199.   ELSE NewList (mp.msgList)
  200.   END;
  201.  
  202.   RETURN mp
  203. END CreatePort;
  204.  
  205. (*------------------------------------*)
  206. PROCEDURE DeletePort * (mp : E.MsgPortPtr);
  207.  
  208. BEGIN (* DeletePort *)
  209.   IF mp = NIL THEN RETURN END;
  210.  
  211.   (* if it was public ... *)
  212.   IF mp.name # NIL THEN E.base.RemPort (mp) END;
  213.  
  214.   (* make it difficult to re-use the port *)
  215.   mp.sigTask := SYS.VAL (E.TaskPtr, -1);
  216.   mp.msgList.head := SYS.VAL (E.MinNodePtr, -1);
  217.  
  218.   E.base.FreeSignal (mp.sigBit);
  219.   SYS.DISPOSE (mp)
  220. END DeletePort;
  221.  
  222. (*--------------------------------------------------------------------*)
  223. (*
  224.   Exec IO procedures.
  225. *)
  226.  
  227.  
  228. (*------------------------------------*)
  229. PROCEDURE BeginIO * ( ioReq : E.IORequestPtr );
  230.  
  231. BEGIN (* BeginIO *)
  232.   SYS.PUTREG (9, ioReq); (* MOVE.L  ioReq(A5), A1 *)
  233.   SYS.INLINE (
  234.     2C69H, 0014H,        (* MOVE.L  0014(A1), A6  *)
  235.     4EAEH, -001EH );     (* JSR     FFE2(A6)      *)
  236. END BeginIO;
  237.  
  238. (*------------------------------------*)
  239. PROCEDURE CreateExtIO *
  240.   ( port   : E.MsgPortPtr;
  241.     ioSize : INTEGER )
  242.   : E.APTR;
  243.  
  244.   VAR ioReq : E.IORequestPtr;
  245.  
  246. BEGIN (* CreateExtIO *)
  247.   IF port = NIL THEN RETURN NIL END;
  248.   Kernel.New (ioReq, ioSize, {E.memPublic, E.memClear});
  249.   IF ioReq # NIL THEN
  250.     ioReq.type := E.ntReplyMsg;
  251.     ioReq.mnLength := ioSize;
  252.     ioReq.replyPort := port
  253.   END;
  254.   RETURN ioReq
  255. END CreateExtIO;
  256.  
  257. (*------------------------------------*)
  258. PROCEDURE DeleteExtIO ( ioReq : E.APTR );
  259.  
  260.   VAR req : E.IORequestPtr;
  261.  
  262. BEGIN (* DeleteExtIO *)
  263.   IF ioReq # NIL THEN
  264.     req := ioReq;
  265.     req.succ := SYS.VAL (E.MinNodePtr, -1);
  266.     req.replyPort := SYS.VAL (E.MsgPortPtr, -1);
  267.     SYS.DISPOSE (req)
  268.   END
  269. END DeleteExtIO;
  270.  
  271. (*------------------------------------*)
  272. PROCEDURE CreateStdIO* ( port : E.MsgPortPtr ) : E.IOStdReqPtr;
  273.  
  274. BEGIN (* CreateStdIO *)
  275.   RETURN CreateExtIO (port, SIZE (E.IOStdReq))
  276. END CreateStdIO;
  277.  
  278. (*------------------------------------*)
  279. PROCEDURE DeleteStdIO* ( ioReq : E.IOStdReqPtr );
  280.  
  281. BEGIN (* DeleteStdIO *)
  282.   DeleteExtIO (ioReq)
  283. END DeleteStdIO;
  284.  
  285. END ExecUtil.
  286.  
  287. (*------------------------------------*)
  288. PROCEDURE CreateTask *
  289.   ( name      : ARRAY OF CHAR;
  290.     pri       : SHORTINT;
  291.     initPC    : E.PROC;
  292.     stackSize : ULONG )
  293.   : E.TaskPtr;
  294.  
  295.   VAR
  296.     taskMemList : RECORD (E.Node)
  297.       numEntries : INTEGER;
  298.       entries : ARRAY 2 OF RECORD
  299.         reqs : SET;
  300.         size : LONGINT;
  301.       END;
  302.     END;
  303.     memList : CPOINTER TO RECORD (E.MemList)
  304.       entries : ARRAY 2 OF E.MemEntry;
  305.     END;
  306.     newTask : E.TaskPtr;
  307.  
  308. BEGIN (* CreateTask *)
  309.   stackSize := SYS.AND (stackSize + 3, 0FFFFFFFCH);
  310.   taskMemList.type := E.ntUnknown;
  311.   taskMemList.pri := 0;
  312.   taskMemList.name := NIL;
  313.   taskMemList.numEntries := 2;
  314.   taskMemList.entries[0].reqs := {E.memPublic, E.memClear};
  315.   taskMemList.entries[0].size := SIZE (E.Task);
  316.   taskMemList.entries[1].reqs := {E.memClear};
  317.   taskMemList.entries[1].size := stackSize;
  318.   memList := E.base.AllocEntry (SYS.ADR (taskMemList));
  319.   IF 31 IN SYS.VAL (SET, memList) THEN RETURN NIL END;
  320.  
  321.   newTask := memList.entries[0].addr;
  322.   newTask.type := E.ntTask;
  323.   newTask.pri := pri;
  324.   newTask.name := SYS.ADR (name);
  325.   newTask.spLower := memList.entries[1].addr;
  326.   newTask.spUpper :=
  327.     SYS.VAL (E.APTR, SYS.VAL (LONGINT, newTask.spLower) + stackSize);
  328.   newTask.spReg := newTask.spUpper;
  329.  
  330.   NewList (newTask.memEntry);
  331.   E.base.AddHead (newTask.memEntry, memList);
  332.   E.base.AddTask (newTask, initPC, NIL);
  333.   RETURN newTask
  334. END CreateTask;
  335.  
  336. (*------------------------------------*)
  337. PROCEDURE DeleteTask * ( task : E.TaskPtr );
  338.  
  339. BEGIN (* DeleteTask *)
  340.   E.base.RemTask (task)
  341. END DeleteTask;
  342.