Locks.Mod 8.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326
  1. MODULE Locks; (** AUTHOR "TF"; PURPOSE "Highlevel locks (recursive, reader writer)"; *)
  2. IMPORT
  3. SYSTEM, KernelLog, Objects, Streams, Reflection, Kernel;
  4. CONST
  5. Statistics = TRUE;
  6. TYPE
  7. (** Non-reentrant lock *)
  8. Lock* = OBJECT
  9. VAR
  10. lockedBy : ANY;
  11. PROCEDURE &New*;
  12. BEGIN
  13. lockedBy := NIL;
  14. END New;
  15. PROCEDURE Acquire*;
  16. VAR me : ANY;
  17. BEGIN {EXCLUSIVE}
  18. me := Objects.ActiveObject();
  19. ASSERT(lockedBy # me, 3005);
  20. AWAIT(lockedBy = NIL);
  21. lockedBy := me;
  22. END Acquire;
  23. PROCEDURE Release*;
  24. BEGIN {EXCLUSIVE}
  25. ASSERT(HasLock(), 3010);
  26. lockedBy := NIL;
  27. END Release;
  28. PROCEDURE HasLock*() : BOOLEAN;
  29. BEGIN
  30. RETURN lockedBy = Objects.ActiveObject();
  31. END HasLock;
  32. END Lock;
  33. TYPE
  34. (** Implements a recursive lock *)
  35. RecursiveLock* = OBJECT
  36. VAR
  37. lockLevel : LONGINT;
  38. lockedBy : ANY;
  39. PROCEDURE &New*;
  40. BEGIN
  41. lockLevel := 0; lockedBy := NIL
  42. END New;
  43. (** acquire a lock on the object *)
  44. PROCEDURE Acquire*;
  45. VAR me : ANY;
  46. BEGIN {EXCLUSIVE}
  47. me := Objects.ActiveObject();
  48. IF lockedBy = me THEN
  49. ASSERT(lockLevel # -1, 3015); (* overflow *)
  50. INC(lockLevel);
  51. ELSE
  52. AWAIT(lockedBy = NIL);
  53. lockedBy := me; lockLevel := 1
  54. END;
  55. END Acquire;
  56. (** release the read/write lock on the object *)
  57. (** MUST hold lock *)
  58. PROCEDURE Release*;
  59. BEGIN {EXCLUSIVE}
  60. ASSERT(HasLock(), 3010);
  61. DEC(lockLevel);
  62. IF lockLevel = 0 THEN lockedBy := NIL END
  63. END Release;
  64. PROCEDURE HasLock*() : BOOLEAN;
  65. BEGIN
  66. RETURN lockedBy = Objects.ActiveObject();
  67. END HasLock;
  68. END RecursiveLock;
  69. TYPE
  70. (** Reader/Writer Lock *)
  71. LockReleasedHandler* = PROCEDURE {DELEGATE} ;
  72. ReaderLockInfo = RECORD
  73. owner : ANY;
  74. lockLevel : LONGINT
  75. END;
  76. ReaderLockList = POINTER TO ARRAY OF ReaderLockInfo;
  77. (** Implements a Reader/Writer lock that can be taken by many readers at the same time, as long as no
  78. writer lock was taken. Only one writer lock is possible at one time. (MREW = Multi Read, Exclusive Write)
  79. Writers can starve. Possible remedies :
  80. simple : Don't let new readers in if a writer made an acquire.
  81. more complicated: Q all acquires and handle in order (optimizing readers)
  82. Readers trying to get a Writer lock result in a trap. Currently no upgrade.
  83. *)
  84. RWLock* = OBJECT
  85. VAR
  86. lockLevel : LONGINT;
  87. lockedBy : ANY; (* writer *)
  88. lastReader : ANY;
  89. nofReaders : LONGINT;
  90. readers : ReaderLockList;
  91. wlReleaseHandler : LockReleasedHandler;
  92. DEADLOCK : BOOLEAN;
  93. nofReadLocks, nofWriteLocks : LONGINT; (* statistics *)
  94. PROCEDURE &New*;
  95. BEGIN
  96. lockLevel := 0; lockedBy := NIL; lastReader := NIL;
  97. nofReaders := 0; NEW(readers, 4);
  98. wlReleaseHandler := NIL;
  99. DEADLOCK := FALSE;
  100. nofReadLocks := 0; nofWriteLocks := 0;
  101. RegisterLock(SELF);
  102. END New;
  103. (** acquire a write-lock on the object *)
  104. PROCEDURE AcquireWrite*;
  105. VAR me, other : ANY;
  106. BEGIN
  107. IF Statistics THEN INC(nofWriteLocks); END;
  108. me := Objects.ActiveObject();
  109. other := lockedBy;
  110. IF lockedBy = me THEN (* recursive use *)
  111. INC(lockLevel);
  112. ASSERT(lockLevel # -1, 3015) (* overflow *)
  113. ELSE
  114. BEGIN {EXCLUSIVE}
  115. (* wait until no other writer and no reader has the lock *)
  116. ASSERT(~(lockedBy = me), 3020);
  117. ASSERT(~InternalHasReadLock(), 3021);
  118. AWAIT(DEADLOCK OR (lockedBy = NIL) & (nofReaders = 0));
  119. IF DEADLOCK THEN HALT(3099) END;
  120. lockedBy := me; lockLevel := 1
  121. END
  122. END
  123. END AcquireWrite;
  124. (** release the write-lock on the object. MUST hold lock *)
  125. PROCEDURE ReleaseWrite*;
  126. VAR inform : BOOLEAN;
  127. BEGIN
  128. inform := FALSE;
  129. BEGIN {EXCLUSIVE}
  130. ASSERT(HasWriteLock(), 3010);
  131. DEC(lockLevel);
  132. IF lockLevel = 0 THEN lockedBy := NIL; inform := TRUE END
  133. END;
  134. (* inform interested parties *)
  135. IF inform & (wlReleaseHandler # NIL) THEN wlReleaseHandler END
  136. END ReleaseWrite;
  137. (** Make sure, the calling process has this write-lock *)
  138. PROCEDURE HasWriteLock*(): BOOLEAN;
  139. BEGIN
  140. RETURN lockedBy = Objects.ActiveObject()
  141. END HasWriteLock;
  142. (** Returns the locklevel of the write lock. [Must hold write lock] *)
  143. PROCEDURE GetWLockLevel*() : LONGINT;
  144. BEGIN
  145. ASSERT(HasWriteLock(), 3000);
  146. RETURN lockLevel
  147. END GetWLockLevel;
  148. PROCEDURE SetLockReleasedHandler*(handler : LockReleasedHandler);
  149. BEGIN
  150. wlReleaseHandler := handler
  151. END SetLockReleasedHandler;
  152. (** acquire a read-lock on the object *)
  153. PROCEDURE AcquireRead*;
  154. VAR me, other : ANY; i : LONGINT; found : BOOLEAN; t : ReaderLockList;
  155. BEGIN {EXCLUSIVE}
  156. IF Statistics THEN INC(nofReadLocks); END;
  157. me := Objects.ActiveObject();
  158. other := lockedBy;
  159. AWAIT(DEADLOCK OR (lockedBy = NIL) OR (lockedBy = me)); (* write owner may acquire a read *)
  160. IF DEADLOCK THEN HALT(3099) END;
  161. lastReader := me;
  162. found := FALSE;
  163. i := 0; WHILE (i < nofReaders) & ~found DO
  164. IF readers[i].owner = me THEN found := TRUE; INC(readers[i].lockLevel); ASSERT(readers[i].lockLevel # -1, 3015) END;
  165. INC(i)
  166. END;
  167. IF ~found THEN
  168. IF nofReaders = LEN(readers) THEN
  169. NEW(t, nofReaders * 2); FOR i := 0 TO nofReaders - 1 DO t[i] := readers[i] END; readers := t;
  170. END;
  171. readers[nofReaders].owner := me; readers[nofReaders].lockLevel := 1;
  172. INC(nofReaders);
  173. END;
  174. END AcquireRead;
  175. (** release the read lock on the object. MUST hold lock *)
  176. PROCEDURE ReleaseRead*;
  177. VAR me : ANY; i : LONGINT; found : BOOLEAN;
  178. BEGIN {EXCLUSIVE}
  179. me := Objects.ActiveObject();
  180. found := FALSE;
  181. i := 0; WHILE (i < nofReaders) & ~found DO
  182. IF readers[i].owner = me THEN found := TRUE; DEC(readers[i].lockLevel);
  183. IF readers[i].lockLevel = 0 THEN
  184. DEC(nofReaders);
  185. WHILE i < nofReaders DO readers[i] := readers[i + 1]; INC(i) END;
  186. readers[nofReaders].owner := NIL; (* for GC *)
  187. lastReader := readers[0].owner
  188. END;
  189. END;
  190. INC(i)
  191. END;
  192. ASSERT(found, 3010)
  193. END ReleaseRead;
  194. (** Make sure, the calling process has a read lock. A write lock implicitly holds the read lock *)
  195. PROCEDURE HasReadLock*() : BOOLEAN;
  196. VAR me : ANY;
  197. BEGIN
  198. me := Objects.ActiveObject();
  199. IF (lockedBy = me) OR (lastReader = me) THEN RETURN TRUE END; (* WriteLock has implicit ReadLock *)
  200. BEGIN {EXCLUSIVE}
  201. RETURN InternalHasReadLock()
  202. END
  203. END HasReadLock;
  204. PROCEDURE InternalHasReadLock(): BOOLEAN;
  205. VAR me : ANY; i : LONGINT;
  206. BEGIN
  207. me := Objects.ActiveObject();
  208. i := 0; WHILE (i < nofReaders) DO
  209. IF readers[i].owner = me THEN RETURN TRUE END;
  210. INC(i)
  211. END;
  212. RETURN FALSE
  213. END InternalHasReadLock;
  214. (** Remove all locks owned by the caller *)
  215. PROCEDURE Reset*;
  216. VAR i, j : LONGINT;me : ANY;
  217. BEGIN {EXCLUSIVE}
  218. me := Objects.ActiveObject();
  219. KernelLog.String("!!! LOCK RESET !!!");
  220. IF lockedBy = me THEN
  221. FOR i := 0 TO nofReaders - 1 DO readers[i].owner := NIL END; nofReaders := 0;
  222. lockLevel := 0; lockedBy := NIL;
  223. KernelLog.String(" --> Removed all locks ");
  224. ELSIF lockedBy = NIL THEN (* only remove locks owned by the caller *)
  225. FOR i := 0 TO nofReaders - 1 DO
  226. IF readers[i].owner = me THEN
  227. FOR j := i TO nofReaders - 2 DO readers[j] := readers[j+1] END;
  228. DEC(nofReaders); readers[nofReaders].owner:= NIL;
  229. KernelLog.String(" --> Removed a readlock");
  230. END;
  231. END
  232. END
  233. END Reset;
  234. PROCEDURE SetDeadLock;
  235. BEGIN {EXCLUSIVE}
  236. DEADLOCK := TRUE
  237. END SetDeadLock;
  238. PROCEDURE WriteLock*;
  239. VAR w : Streams.Writer; tag: ADDRESS;
  240. BEGIN
  241. KernelLog.String("Lock held by : ");
  242. IF lockedBy = NIL THEN KernelLog.String("nobody")
  243. ELSE
  244. KernelLog.String("locked by = "); KernelLog.Address(lockedBy); KernelLog.Ln;
  245. KernelLog.String("me = "); KernelLog.Address(Objects.ActiveObject()); KernelLog.Ln;
  246. (*
  247. Streams.OpenWriter(w, KernelLog.Send);
  248. SYSTEM.GET (SYSTEM.VAL (ADDRESS, lockedBy) - SIZEOF (ADDRESS), tag);
  249. Reflection.WriteType(w, tag);
  250. w.String(" New Acquire by : ");
  251. SYSTEM.GET (SYSTEM.VAL (ADDRESS, Objects.ActiveObject()) - SIZEOF (ADDRESS), tag);
  252. Reflection.WriteType(w, tag);
  253. w.Update
  254. *)
  255. END;
  256. KernelLog.Ln;
  257. END WriteLock;
  258. PROCEDURE WriteStats*;
  259. BEGIN {EXCLUSIVE}
  260. KernelLog.String("nofReadLocks : "); KernelLog.Int(nofReadLocks, 4); KernelLog.Ln;
  261. KernelLog.String("nofWriteLocks : "); KernelLog.Int(nofWriteLocks, 4); KernelLog.Ln;
  262. KernelLog.String("current readers : "); KernelLog.Int(nofReaders, 4); KernelLog.Ln;
  263. KernelLog.String("current writer : "); IF lockedBy # NIL THEN KernelLog.String(" not NIL") ELSE KernelLog.String("is NIL") END;
  264. END WriteStats;
  265. END RWLock;
  266. VAR
  267. locks : Kernel.FinalizedCollection;
  268. PROCEDURE RegisterLock(x : ANY);
  269. BEGIN
  270. locks.Add(x, NIL);
  271. END RegisterLock;
  272. PROCEDURE DL(obj: ANY; VAR cont: BOOLEAN);
  273. BEGIN
  274. obj(RWLock).SetDeadLock; cont := TRUE;
  275. END DL;
  276. PROCEDURE DeadLock*;
  277. BEGIN
  278. locks.Enumerate(DL);
  279. END DeadLock;
  280. BEGIN
  281. NEW(locks);
  282. END Locks.