home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon-a / source / amigautil / executil.mod < prev    next >
Text File  |  1995-06-29  |  4KB  |  144 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.9 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/04 23:18:08 $
  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. <* STANDARD- *>
  18.  
  19. MODULE ExecUtil;
  20.  
  21. IMPORT SYS := SYSTEM, e := Exec;
  22.  
  23. TYPE
  24.  
  25.   CompareProc * = PROCEDURE ( n1, n2 : e.CommonNodePtr ) : INTEGER;
  26.  
  27.  
  28. (*--------------------------------------------------------------------*)
  29. (*
  30.   Exec List handling procedures
  31. *)
  32.  
  33.  
  34. (*------------------------------------*)
  35. PROCEDURE GetSucc * ( node : e.CommonNodePtr ) : e.CommonNodePtr;
  36.   VAR mn : e.MinNodePtr;
  37. BEGIN (* GetSucc *)
  38.   mn := SYS.VAL (e.MinNodePtr, node);
  39.   IF mn # NIL THEN
  40.     mn := mn.succ; IF mn.succ = NIL THEN mn := NIL END
  41.   END;
  42.   RETURN mn
  43. END GetSucc;
  44.  
  45.  
  46. (*------------------------------------*)
  47. PROCEDURE GetPred * ( node : e.CommonNodePtr ) : e.CommonNodePtr;
  48.   VAR mn : e.MinNodePtr;
  49. BEGIN (* GetPred *)
  50.   mn := SYS.VAL (e.MinNodePtr, node);
  51.   IF mn # NIL THEN
  52.     mn := mn.pred; IF mn.pred = NIL THEN mn := NIL END
  53.   END;
  54.   RETURN mn
  55. END GetPred;
  56.  
  57.  
  58. (*------------------------------------*)
  59. PROCEDURE GetHead * ( VAR list : e.CommonList ) : e.CommonNodePtr;
  60.   VAR ml : e.MinListPtr; mn : e.MinNodePtr;
  61. BEGIN (* GetHead *)
  62.   ml := SYS.ADR (list);
  63.   mn := ml.head; IF mn.succ = NIL THEN mn := NIL END;
  64.   RETURN mn
  65. END GetHead;
  66.  
  67.  
  68. (*------------------------------------*)
  69. PROCEDURE GetTail * ( VAR list : e.CommonList ) : e.CommonNodePtr;
  70.   VAR ml : e.MinListPtr; mn : e.MinNodePtr;
  71. BEGIN (* GetTail *)
  72.   ml := SYS.ADR (list);
  73.   mn := ml.tailPred; IF mn.pred = NIL THEN mn := NIL END;
  74.   RETURN mn
  75. END GetTail;
  76.  
  77.  
  78. (*------------------------------------*)
  79. PROCEDURE ListLength * ( VAR list : e.CommonList ) : LONGINT;
  80.   VAR ml : e.MinListPtr; mn : e.MinNodePtr; count : LONGINT;
  81. BEGIN (* ListLength *)
  82.   count := 0; ml := SYS.ADR (list); mn := ml.head;
  83.   WHILE mn.succ # NIL DO INC (count); mn := mn.succ END;
  84.   RETURN count;
  85. END ListLength;
  86.  
  87.  
  88. (*------------------------------------*)
  89. PROCEDURE NodeAt * ( VAR list : e.CommonList; pos : LONGINT )
  90.   : e.CommonNodePtr;
  91.   VAR ml : e.MinListPtr; mn : e.MinNodePtr; count : LONGINT;
  92. BEGIN (* NodeAt *)
  93.   count := pos; ml := SYS.ADR (list); mn := ml.head;
  94.   IF mn # NIL THEN
  95.     WHILE (mn.succ # NIL) & (count > 0) DO
  96.       DEC( count ); mn := mn.succ;
  97.     END;
  98.     IF mn.succ = NIL THEN mn := NIL END
  99.   END;
  100.   RETURN mn
  101. END NodeAt;
  102.  
  103.  
  104. (*------------------------------------*)
  105. PROCEDURE InsertAt *
  106.   ( VAR list : e.CommonList; node : e.CommonNodePtr; pos : LONGINT );
  107.   VAR mn : e.MinNodePtr;
  108. BEGIN (* InsertAt *)
  109.   mn := SYS.VAL (e.MinNodePtr, NodeAt (list, pos));
  110.   IF mn = NIL THEN e.AddTail (list, node)
  111.   ELSE e.Insert (list, node, mn.pred)
  112.   END
  113. END InsertAt;
  114.  
  115.  
  116. (*------------------------------------*)
  117. PROCEDURE InsertOrdered *
  118.   ( VAR list : e.CommonList; node : e.CommonNodePtr; Compare : CompareProc )
  119.   : LONGINT;
  120.   VAR pn, nn : e.MinNodePtr; position : LONGINT;
  121. BEGIN (* InsertOrdered *)
  122.   position := 0; pn := NIL; nn := SYS.VAL (e.MinNodePtr, GetHead (list));
  123.   WHILE (nn # NIL) & (Compare (node, nn) >= 0) DO
  124.     pn := nn; nn := SYS.VAL (e.MinNodePtr, GetSucc (nn));
  125.     INC (position)
  126.   END;
  127.   e.Insert (list, node, pn);
  128.   RETURN position;
  129. END InsertOrdered;
  130.  
  131.  
  132. (*------------------------------------*)
  133. PROCEDURE RemoveAt * ( VAR list : e.CommonList; pos : LONGINT )
  134.   : e.CommonNodePtr;
  135.   VAR node : e.CommonNodePtr;
  136. BEGIN (* RemoveAt *)
  137.   node := NodeAt( list, pos );
  138.   IF node # NIL THEN e.Remove (node) END;
  139.   RETURN node;
  140. END RemoveAt;
  141.  
  142.  
  143. END ExecUtil.
  144.