Trurl-based/System/Mod/Services.txt

   1 MODULE Services;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Services.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT SYSTEM, Kernel;
   7
   8         CONST
   9                 now* = 0; immediately* = -1;    (** DoLater notBefore **)
  10                 resolution* = 1000;
  11                 scale = resolution DIV Kernel.timeResolution;
  12                 corr = resolution MOD Kernel.timeResolution;
  13
  14
  15         TYPE
  16                 Action* = POINTER TO ABSTRACT RECORD
  17                         notBefore: LONGINT;
  18                         next: Action    (* next element in linear list *)
  19                 END;
  20
  21                 ActionHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
  22                 StdHook = POINTER TO RECORD (ActionHook) END;
  23
  24
  25         VAR
  26                 actionHook-: ActionHook;
  27                 actions: Action;                        (* list of actions *)
  28                 candidates: Action;             (* list of action candidates in IterateOverActions,
  29                                                                                                 NIL during normal execution of commands *)
  30                 hasImmediates: BOOLEAN; (* this is a hint: one or more actions in some ring may be immediate actions *)
  31                 trapCnt: INTEGER;
  32
  33
  34         PROCEDURE Ticks* (): LONGINT;
  35                 VAR t: LONGINT;
  36         BEGIN
  37                 t := Kernel.Time();
  38                 RETURN t * scale + t * corr DIV Kernel.timeResolution
  39         END Ticks;
  40
  41
  42         (** Action **)
  43
  44         PROCEDURE (a: Action) Do- (), NEW, ABSTRACT;
  45
  46         PROCEDURE In (l, a: Action): BOOLEAN;
  47         BEGIN
  48                 WHILE (l # NIL) & (l # a) DO l := l.next END;
  49                 RETURN l # NIL
  50         END In;
  51
  52         PROCEDURE Incl (VAR l: Action; a: Action);
  53         BEGIN
  54                 IF l # NIL THEN a.next := l END;
  55                 l := a
  56         END Incl;
  57
  58         PROCEDURE Excl (VAR l: Action; a: Action);
  59                 VAR p0, p1: Action;
  60         BEGIN
  61                 IF l = a THEN
  62                         l := a.next; a.next := NIL
  63                 ELSIF l # NIL THEN
  64                         p0 := l; p1 := p0.next;
  65                         (* (p0 # NIL) & (p0 # a) *)
  66                         WHILE (p1 # NIL) & (p1 # a) DO p0 := p1; p1 := p0.next END;
  67                         IF p1 = a THEN p0.next := a.next; a.next := NIL END
  68                 END
  69         END Excl;
  70
  71         PROCEDURE Exec (a: Action);
  72                 VAR t: Kernel.Type;
  73         BEGIN
  74                 t := Kernel.TypeOf(a);
  75                 IF t.mod.refcnt >= 0 THEN       (* execute action if its module is not unloaded *)
  76                         a.Do    (* warning: here the actions and candidates lists may be modified, or a trap may occur! *)
  77                 END
  78         END Exec;
  79
  80         PROCEDURE Cleanup;
  81                 VAR p: Action;
  82         BEGIN
  83                 IF candidates # NIL THEN        (* trap handling *)
  84                         p := candidates; WHILE p.next # NIL DO p := p.next END; (* find last element of candidates list *)
  85                         p.next := actions; actions := candidates; candidates := NIL     (* prepend candidates list to actions list *)
  86                 END;
  87                 trapCnt := Kernel.trapCount     (* all traps are handled now *)
  88         END Cleanup;
  89
  90         PROCEDURE DoLater* (a: Action; notBefore: LONGINT);
  91         (** Register action a. If a is already registered, its notBefore value is updated instead. **)
  92         BEGIN
  93                 ASSERT(a # NIL, 20);
  94                 IF ~In(actions, a) & ~In(candidates, a) THEN
  95                         Incl(actions, a)
  96                 END;
  97                 a.notBefore := notBefore;       (* if a was already in a list, this statement updates the notBefore value *)
  98                 IF notBefore = immediately THEN hasImmediates := TRUE END
  99         END DoLater;
 100
 101         PROCEDURE RemoveAction* (a: Action);
 102         (** Unregister action a. If a is not registered, nothing happens **)
 103         BEGIN
 104                 IF a # NIL THEN
 105                         Excl(actions, a);
 106                         Excl(candidates, a)
 107                 END
 108         END RemoveAction;
 109
 110         PROCEDURE IterateOverActions (time: LONGINT);
 111                 VAR p: Action;
 112         BEGIN
 113                 Cleanup;        (* trap handling, if necessary *)
 114                 (* candidates = NIL *)
 115                 candidates := actions; actions := NIL;          (* move action list to candidates list *)
 116                 WHILE candidates # NIL DO                                       (* for every candidate: execute it or put it back into actions list *)
 117                         p := candidates; candidates := p.next;  (* remove head element from candidates list *)
 118                         IF (0 <= p.notBefore) & (p.notBefore <= time) OR (p.notBefore <= time) & (time < 0) THEN
 119                                 p.next := NIL; Exec(p)                                  (* warning: p may call DoLater or RemoveAction,
 120                                                                                                                                                 which change the lists! *)
 121                         ELSE
 122                                 p.next := actions; actions := p         (* move to actions list for later processing *)
 123                         END
 124                 END
 125         END IterateOverActions;
 126
 127
 128         PROCEDURE (h: ActionHook) Step*, NEW, ABSTRACT;
 129
 130         PROCEDURE (h: ActionHook) Loop*, NEW, ABSTRACT;
 131
 132
 133         PROCEDURE (h: StdHook) Step;
 134         BEGIN
 135                 IF (candidates = NIL) OR (trapCnt < Kernel.trapCount) THEN
 136                         IterateOverActions(Ticks())
 137                 END
 138         END Step;
 139
 140         PROCEDURE (h: StdHook) Loop;
 141         BEGIN
 142                 IF hasImmediates THEN
 143                         ASSERT((candidates = NIL) OR (trapCnt < Kernel.trapCount), 100);
 144                         IterateOverActions(immediately);
 145                         hasImmediates := FALSE
 146                 END
 147         END Loop;
 148
 149
 150         (* type handling functions *)
 151
 152         PROCEDURE ThisDesc (IN type: ARRAY OF CHAR; load: BOOLEAN): Kernel.Type;
 153                 CONST record = 1; pointer = 3;
 154                 VAR m: Kernel.Module; t: Kernel.Type; i, j: INTEGER; ch: CHAR;
 155                         typ: Kernel.Name; mod: ARRAY 256 OF CHAR;
 156         BEGIN
 157                 ASSERT(type # "", 20);
 158                 i := 0; ch := type[0];
 159                 WHILE (ch # ".") & (ch # 0X) DO mod[i] := ch; INC(i); ch := type[i] END;
 160                 ASSERT(ch = ".", 21);
 161                 mod[i] := 0X; INC(i); t := NIL;
 162                 IF load THEN
 163                         m := Kernel.ThisMod(mod)
 164                 ELSE typ := SHORT(mod$); m := Kernel.ThisLoadedMod(typ)
 165                 END;
 166
 167                 IF m # NIL THEN
 168                         j := 0; REPEAT ch := type[i]; typ[j] := SHORT(ch); INC(i); INC(j) UNTIL ch = 0X;
 169                         t := Kernel.ThisType(m, typ);
 170                         IF t = NIL THEN typ[j - 1] := "^"; typ[j] := 0X; t := Kernel.ThisType(m, typ) END
 171                 END;
 172                 IF t # NIL THEN
 173                         IF t.id MOD 4 = pointer THEN t := t.base[0] END;
 174                         IF t.id MOD 4 # record THEN t := NIL END
 175                 END;
 176                 RETURN t
 177         END ThisDesc;
 178
 179         PROCEDURE GetTypeName* (IN rec: ANYREC; OUT type: ARRAY OF CHAR);
 180                 VAR i, j: INTEGER; ch: CHAR; t: Kernel.Type; name: Kernel.Name;
 181         BEGIN
 182                 t := Kernel.TypeOf(rec);
 183                 Kernel.GetTypeName(t, name); type := t.mod.name$;
 184                 i := 0; ch := type[0]; WHILE ch # 0X DO INC(i); ch := type[i] END;
 185                 type[i] := "."; INC(i);
 186                 j := 0; REPEAT ch := name[j]; type[i] := ch; INC(i); INC(j) UNTIL ch = 0X;
 187                 IF type[i - 2] = "^" THEN type[i - 2] := 0X END
 188         END GetTypeName;
 189
 190         PROCEDURE SameType* (IN ra, rb: ANYREC): BOOLEAN;
 191         BEGIN
 192                 RETURN Kernel.TypeOf(ra) = Kernel.TypeOf(rb)
 193         END SameType;
 194
 195         PROCEDURE IsExtensionOf* (IN ra, rb: ANYREC): BOOLEAN;
 196                 VAR ta, tb: Kernel.Type;
 197         BEGIN
 198                 ta := Kernel.TypeOf(ra); tb := Kernel.TypeOf(rb);
 199                 RETURN ta.base[tb.id DIV 16 MOD 16] = tb
 200         END IsExtensionOf;
 201
 202         PROCEDURE Is* (IN rec: ANYREC; IN type: ARRAY OF CHAR): BOOLEAN;
 203                 VAR ta, tb: Kernel.Type;
 204         BEGIN
 205                 ta := Kernel.TypeOf(rec); tb := ThisDesc(type, FALSE);
 206                 IF tb # NIL THEN RETURN ta.base[tb.id DIV 16 MOD 16] = tb
 207                 ELSE RETURN FALSE
 208                 END
 209         END Is;
 210
 211         PROCEDURE Extends* (IN type, base: ARRAY OF CHAR): BOOLEAN;
 212                 VAR ta, tb: Kernel.Type;
 213         BEGIN
 214                 ASSERT((type # "") & (base # ""), 20);
 215                 ta := ThisDesc(type, TRUE); tb := ThisDesc(base, FALSE);
 216                 IF (ta # NIL) & (tb # NIL) THEN RETURN ta.base[tb.id DIV 16 MOD 16] = tb
 217                 ELSE RETURN FALSE
 218                 END
 219         END Extends;
 220
 221         PROCEDURE Level* (IN type: ARRAY OF CHAR): INTEGER;
 222                 VAR t: Kernel.Type;
 223         BEGIN
 224                 t := ThisDesc(type, TRUE);
 225                 RETURN t.id DIV 16 MOD 16
 226         END Level;
 227
 228         PROCEDURE TypeLevel* (IN rec: ANYREC): INTEGER;
 229                 VAR t: Kernel.Type;
 230         BEGIN
 231                 t := Kernel.TypeOf(rec);
 232                 IF t = NIL THEN RETURN -1
 233                 ELSE RETURN t.id DIV 16 MOD 16
 234                 END
 235         END TypeLevel;
 236
 237         PROCEDURE AdrOf* (IN rec: ANYREC): INTEGER;
 238         BEGIN
 239                 RETURN SYSTEM.ADR(rec)
 240         END AdrOf;
 241
 242         PROCEDURE Collect*;
 243         BEGIN
 244                 Kernel.FastCollect
 245         END Collect;
 246
 247
 248         PROCEDURE Init;
 249                 VAR h: StdHook;
 250         BEGIN
 251                 NEW(h); actionHook := h
 252         END Init;
 253
 254 BEGIN
 255         Init
 256 END Services.