CSP.mod 6.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347
  1. (*$R-*)
  2. IMPLEMENTATION MODULE CSP;
  3. (*
  4. Module: Communicating Sequential Processes
  5. From: "A Modula-2 Implementation of CSP",
  6. M. Collado, R. Morales, J.J. Moreno,
  7. SIGPlan Notices, Volume 22, Number 6, June 1987.
  8. Some modifications by Ceriel J.H. Jacobs
  9. Version: $Id$
  10. See this article for an explanation of the use of this module.
  11. *)
  12. FROM random IMPORT Uniform;
  13. FROM SYSTEM IMPORT BYTE, ADDRESS, NEWPROCESS, TRANSFER;
  14. FROM Storage IMPORT Allocate, Deallocate;
  15. FROM Traps IMPORT Message;
  16. CONST WorkSpaceSize = 2000;
  17. TYPE ByteAddress = POINTER TO BYTE;
  18. Channel = POINTER TO ChannelDescriptor;
  19. ProcessType = POINTER TO ProcessDescriptor;
  20. ProcessDescriptor = RECORD
  21. next: ProcessType;
  22. father: ProcessType;
  23. cor: ADDRESS;
  24. wsp: ADDRESS;
  25. guardindex: INTEGER;
  26. guardno: CARDINAL;
  27. guardcount: CARDINAL;
  28. opened: Channel;
  29. sons: CARDINAL;
  30. msgadr: ADDRESS;
  31. msglen: CARDINAL;
  32. END;
  33. Queue = RECORD
  34. head, tail: ProcessType;
  35. END;
  36. ChannelDescriptor = RECORD
  37. senders: Queue;
  38. owner: ProcessType;
  39. guardindex: INTEGER;
  40. next: Channel;
  41. END;
  42. VAR cp: ProcessType;
  43. free, ready: Queue;
  44. (* ------------ Private modules and procedures ------------- *)
  45. MODULE ProcessQueue;
  46. IMPORT ProcessType, Queue;
  47. EXPORT Push, Pop, InitQueue, IsEmpty;
  48. PROCEDURE InitQueue(VAR q: Queue);
  49. BEGIN
  50. WITH q DO
  51. head := NIL;
  52. tail := NIL
  53. END
  54. END InitQueue;
  55. PROCEDURE Push(p: ProcessType; VAR q: Queue);
  56. BEGIN
  57. p^.next := NIL;
  58. WITH q DO
  59. IF head = NIL THEN
  60. tail := p
  61. ELSE
  62. head^.next := p
  63. END;
  64. head := p
  65. END
  66. END Push;
  67. PROCEDURE Pop(VAR q: Queue; VAR p: ProcessType);
  68. BEGIN
  69. WITH q DO
  70. p := tail;
  71. IF p # NIL THEN
  72. tail := tail^.next;
  73. IF head = p THEN
  74. head := NIL
  75. END
  76. END
  77. END
  78. END Pop;
  79. PROCEDURE IsEmpty(q: Queue): BOOLEAN;
  80. BEGIN
  81. RETURN q.head = NIL
  82. END IsEmpty;
  83. END ProcessQueue;
  84. PROCEDURE DoTransfer;
  85. VAR aux: ProcessType;
  86. BEGIN
  87. aux := cp;
  88. Pop(ready, cp);
  89. IF cp = NIL THEN
  90. HALT
  91. ELSE
  92. TRANSFER(aux^.cor, cp^.cor)
  93. END
  94. END DoTransfer;
  95. PROCEDURE OpenChannel(ch: Channel; n: INTEGER);
  96. BEGIN
  97. WITH ch^ DO
  98. IF guardindex = 0 THEN
  99. guardindex := n;
  100. next := cp^.opened;
  101. cp^.opened := ch
  102. END
  103. END
  104. END OpenChannel;
  105. PROCEDURE CloseChannels(p: ProcessType);
  106. BEGIN
  107. WITH p^ DO
  108. WHILE opened # NIL DO
  109. opened^.guardindex := 0;
  110. opened := opened^.next
  111. END
  112. END
  113. END CloseChannels;
  114. PROCEDURE ThereAreOpenChannels(): BOOLEAN;
  115. BEGIN
  116. RETURN cp^.opened # NIL;
  117. END ThereAreOpenChannels;
  118. PROCEDURE Sending(ch: Channel): BOOLEAN;
  119. BEGIN
  120. RETURN NOT IsEmpty(ch^.senders)
  121. END Sending;
  122. (* -------------- Public Procedures ----------------- *)
  123. PROCEDURE COBEGIN;
  124. (* Beginning of a COBEGIN .. COEND structure *)
  125. BEGIN
  126. END COBEGIN;
  127. PROCEDURE COEND;
  128. (* End of a COBEGIN .. COEND structure *)
  129. (* VAR aux: ProcessType; *)
  130. BEGIN
  131. IF cp^.sons > 0 THEN
  132. DoTransfer
  133. END
  134. END COEND;
  135. PROCEDURE StartProcess(P: PROC);
  136. (* Start an anonimous process that executes the procedure P *)
  137. VAR newprocess: ProcessType;
  138. BEGIN
  139. Pop(free, newprocess);
  140. IF newprocess = NIL THEN
  141. Allocate(newprocess,SIZE(ProcessDescriptor));
  142. Allocate(newprocess^.wsp, WorkSpaceSize)
  143. END;
  144. WITH newprocess^ DO
  145. father := cp;
  146. sons := 0;
  147. msglen := 0;
  148. NEWPROCESS(P, wsp, WorkSpaceSize, cor)
  149. END;
  150. cp^.sons := cp^.sons + 1;
  151. Push(newprocess, ready)
  152. END StartProcess;
  153. PROCEDURE StopProcess;
  154. (* Terminate a Process (itself) *)
  155. VAR aux: ProcessType;
  156. BEGIN
  157. aux := cp^.father;
  158. aux^.sons := aux^.sons - 1;
  159. IF aux^.sons = 0 THEN
  160. Push(aux, ready)
  161. END;
  162. aux := cp;
  163. Push(aux, free);
  164. Pop(ready, cp);
  165. IF cp = NIL THEN
  166. HALT
  167. ELSE
  168. TRANSFER(aux^.cor, cp^.cor)
  169. END
  170. END StopProcess;
  171. PROCEDURE InitChannel(VAR ch: Channel);
  172. (* Initialize the channel ch *)
  173. BEGIN
  174. Allocate(ch, SIZE(ChannelDescriptor));
  175. WITH ch^ DO
  176. InitQueue(senders);
  177. owner := NIL;
  178. next := NIL;
  179. guardindex := 0
  180. END
  181. END InitChannel;
  182. PROCEDURE GetChannel(ch: Channel);
  183. (* Assign the channel ch to the process that gets it *)
  184. BEGIN
  185. WITH ch^ DO
  186. IF owner # NIL THEN
  187. Message("Channel already has an owner");
  188. HALT
  189. END;
  190. owner := cp
  191. END
  192. END GetChannel;
  193. PROCEDURE Send(data: ARRAY OF BYTE; VAR ch: Channel);
  194. (* Send a message with the data to the cvhannel ch *)
  195. VAR m: ByteAddress;
  196. (* aux: ProcessType; *)
  197. i: CARDINAL;
  198. BEGIN
  199. WITH ch^ DO
  200. Push(cp, senders);
  201. Allocate(cp^.msgadr, SIZE(data));
  202. m := cp^.msgadr;
  203. cp^.msglen := HIGH(data);
  204. FOR i := 0 TO HIGH(data) DO
  205. m^ := data[i];
  206. m := ADDRESS(m) + 1
  207. END;
  208. IF guardindex # 0 THEN
  209. owner^.guardindex := guardindex;
  210. CloseChannels(owner);
  211. Push(owner, ready)
  212. END
  213. END;
  214. DoTransfer
  215. END Send;
  216. PROCEDURE Receive(VAR ch: Channel; VAR dest: ARRAY OF BYTE);
  217. (* Receive a message from the channel ch into the dest variable *)
  218. VAR aux: ProcessType;
  219. m: ByteAddress;
  220. i: CARDINAL;
  221. BEGIN
  222. WITH ch^ DO
  223. IF cp # owner THEN
  224. Message("Only owner of channel can receive from it");
  225. HALT
  226. END;
  227. IF Sending(ch) THEN
  228. Pop(senders, aux);
  229. m := aux^.msgadr;
  230. FOR i := 0 TO aux^.msglen DO
  231. dest[i] := m^;
  232. m := ADDRESS(m) + 1
  233. END;
  234. Push(aux, ready);
  235. Push(cp, ready);
  236. CloseChannels(cp)
  237. ELSE
  238. OpenChannel(ch, -1);
  239. DoTransfer;
  240. Pop(senders, aux);
  241. m := aux^.msgadr;
  242. FOR i := 0 TO aux^.msglen DO
  243. dest[i] := m^;
  244. m := ADDRESS(m) + 1
  245. END;
  246. Push(cp, ready);
  247. Push(aux, ready)
  248. END;
  249. Deallocate(aux^.msgadr, aux^.msglen+1);
  250. DoTransfer
  251. END
  252. END Receive;
  253. PROCEDURE SELECT(n: CARDINAL);
  254. (* Beginning of a SELECT structure with n guards *)
  255. BEGIN
  256. cp^.guardindex := Uniform(1,n);
  257. cp^.guardno := n;
  258. cp^.guardcount := n
  259. END SELECT;
  260. PROCEDURE NEXTGUARD(): CARDINAL;
  261. (* Returns an index to the next guard to be evaluated in a SELECT *)
  262. BEGIN
  263. RETURN cp^.guardindex
  264. END NEXTGUARD;
  265. PROCEDURE GUARD(cond: BOOLEAN; ch: Channel;
  266. VAR dest: ARRAY OF BYTE): BOOLEAN;
  267. (* Evaluates a guard, including reception management *)
  268. (* VAR aux: ProcessType; *)
  269. BEGIN
  270. IF NOT cond THEN
  271. RETURN FALSE
  272. ELSIF ch = NIL THEN
  273. CloseChannels(cp);
  274. cp^.guardindex := 0;
  275. RETURN TRUE
  276. ELSIF Sending(ch) THEN
  277. Receive(ch, dest);
  278. cp^.guardindex := 0;
  279. RETURN TRUE
  280. ELSE
  281. OpenChannel(ch, cp^.guardindex);
  282. RETURN FALSE
  283. END
  284. END GUARD;
  285. PROCEDURE ENDSELECT(): BOOLEAN;
  286. (* End of a SELECT structure *)
  287. BEGIN
  288. WITH cp^ DO
  289. IF guardindex <= 0 THEN
  290. RETURN TRUE
  291. END;
  292. guardcount := guardcount - 1;
  293. IF guardcount # 0 THEN
  294. guardindex := (guardindex MOD INTEGER(guardno)) + 1
  295. ELSIF ThereAreOpenChannels() THEN
  296. DoTransfer
  297. ELSE
  298. guardindex := 0
  299. END
  300. END;
  301. RETURN FALSE
  302. END ENDSELECT;
  303. BEGIN
  304. InitQueue(free);
  305. InitQueue(ready);
  306. Allocate(cp,SIZE(ProcessDescriptor));
  307. WITH cp^ DO
  308. sons := 0;
  309. father := NIL
  310. END
  311. END CSP.