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