From: ceriel Date: Thu, 9 Jul 1987 15:15:22 +0000 (+0000) Subject: changed random function, added CSP module X-Git-Tag: release-5-5~4024 X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=c7d4d3520099db38b8a59f69938d5168c6ba31e4;p=ack.git changed random function, added CSP module --- diff --git a/lang/m2/libm2/.distr b/lang/m2/libm2/.distr index 3ccc63568..5f441a030 100644 --- a/lang/m2/libm2/.distr +++ b/lang/m2/libm2/.distr @@ -21,3 +21,4 @@ Unix.def head_m2.e random.def Traps.def +CSP.def diff --git a/lang/m2/libm2/CSP.def b/lang/m2/libm2/CSP.def new file mode 100644 index 000000000..4d0d3193d --- /dev/null +++ b/lang/m2/libm2/CSP.def @@ -0,0 +1,51 @@ +DEFINITION MODULE CSP; +(* From + "A Modula-2 Implementation of CSP", + M. Collado, R. Morales, J.J. Moreno, + SIGPlan Notices, Volume 22, Number 6, June 1987. + + See this article for an explanation of the use of this module. +*) + + FROM SYSTEM IMPORT BYTE; + + TYPE Channel; + + PROCEDURE COBEGIN; + (* Beginning of a COBEGIN .. COEND structure *) + + PROCEDURE COEND; + (* End of a COBEGIN .. COEND structure *) + + PROCEDURE StartProcess(P: PROC); + (* Start an anonimous process that executes the procedure P *) + + PROCEDURE StopProcess; + (* Terminate a Process (itself) *) + + PROCEDURE InitChannel(VAR ch: Channel); + (* Initialize the channel ch *) + + PROCEDURE GetChannel(ch: Channel); + (* Assign the channel ch to the process that gets it *) + + PROCEDURE Send(data: ARRAY OF BYTE; VAR ch: Channel); + (* Send a message with the data to the cvhannel ch *) + + PROCEDURE Receive(VAR ch: Channel; VAR dest: ARRAY OF BYTE); + (* Receive a message from the channel ch into the dest variable *) + + PROCEDURE SELECT(n: CARDINAL); + (* Beginning of a SELECT structure with n guards *) + + PROCEDURE NEXTGUARD(): CARDINAL; + (* Returns an index to the next guard to be evaluated in a SELECT *) + + PROCEDURE GUARD(cond: BOOLEAN; ch: Channel; + VAR dest: ARRAY OF BYTE): BOOLEAN; + (* Evaluates a guard, including reception management *) + + PROCEDURE ENDSELECT(): BOOLEAN; + (* End of a SELECT structure *) + +END CSP. diff --git a/lang/m2/libm2/CSP.mod b/lang/m2/libm2/CSP.mod new file mode 100644 index 000000000..ee723cbcd --- /dev/null +++ b/lang/m2/libm2/CSP.mod @@ -0,0 +1,343 @@ +IMPLEMENTATION MODULE CSP; +(* From + "A Modula-2 Implementation of CSP", + M. Collado, R. Morales, J.J. Moreno, + SIGPlan Notices, Volume 22, Number 6, June 1987. + + See this article for an explanation of the use of this module. +*) + + FROM random IMPORT Uniform; + FROM SYSTEM IMPORT BYTE, TSIZE, ADDRESS, ADR, NEWPROCESS, TRANSFER; + FROM Storage IMPORT ALLOCATE, DEALLOCATE; + IMPORT Traps; + + CONST WorkSpaceSize = 1000; + + TYPE ByteAddress = POINTER TO BYTE; + Channel = POINTER TO ChannelDescriptor; + ProcessType = POINTER TO ProcessDescriptor; + ProcessDescriptor = RECORD + next: ProcessType; + father: ProcessType; + cor: ADDRESS; + wsp: ADDRESS; + guardindex: INTEGER; + guardno: CARDINAL; + guardcount: CARDINAL; + opened: Channel; + sons: CARDINAL; + msgadr: ADDRESS; + msglen: CARDINAL; + END; + + Queue = RECORD + head, tail: ProcessType; + END; + + ChannelDescriptor = RECORD + senders: Queue; + owner: ProcessType; + guardindex: INTEGER; + next: Channel; + END; + + VAR cp: ProcessType; + free, ready: Queue; + +(* ------------ Private modules and procedures ------------- *) + + MODULE ProcessQueue; + + IMPORT ProcessType, Queue; + EXPORT Push, Pop, InitQueue, IsEmpty; + + PROCEDURE InitQueue(VAR q: Queue); + BEGIN + WITH q DO + head := NIL; + tail := NIL + END + END InitQueue; + + PROCEDURE Push(p: ProcessType; VAR q: Queue); + BEGIN + p^.next := NIL; + WITH q DO + IF head = NIL THEN + tail := p + ELSE + head^.next := p + END; + head := p + END + END Push; + + PROCEDURE Pop(VAR q: Queue; VAR p: ProcessType); + BEGIN + WITH q DO + p := tail; + IF p # NIL THEN + tail := tail^.next; + IF head = p THEN + head := NIL + END + END + END + END Pop; + + PROCEDURE IsEmpty(q: Queue): BOOLEAN; + BEGIN + RETURN q.head = NIL + END IsEmpty; + + END ProcessQueue; + + + PROCEDURE DoTransfer; + VAR aux: ProcessType; + BEGIN + aux := cp; + Pop(ready, cp); + IF cp = NIL THEN + HALT + ELSE + TRANSFER(aux^.cor, cp^.cor) + END + END DoTransfer; + + PROCEDURE OpenChannel(ch: Channel; n: INTEGER); + BEGIN + WITH ch^ DO + IF guardindex = 0 THEN + guardindex := n; + next := cp^.opened; + cp^.opened := ch + END + END + END OpenChannel; + + PROCEDURE CloseChannels(p: ProcessType); + BEGIN + WITH p^ DO + WHILE opened # NIL DO + opened^.guardindex := 0; + opened := opened^.next + END + END + END CloseChannels; + + PROCEDURE ThereAreOpenChannels(): BOOLEAN; + BEGIN + RETURN cp^.opened # NIL; + END ThereAreOpenChannels; + + PROCEDURE Sending(ch: Channel): BOOLEAN; + BEGIN + RETURN NOT IsEmpty(ch^.senders) + END Sending; + +(* -------------- Public Procedures ----------------- *) + + PROCEDURE COBEGIN; + (* Beginning of a COBEGIN .. COEND structure *) + BEGIN + END COBEGIN; + + PROCEDURE COEND; + (* End of a COBEGIN .. COEND structure *) + VAR aux: ProcessType; + BEGIN + IF cp^.sons > 0 THEN + DoTransfer + END + END COEND; + + PROCEDURE StartProcess(P: PROC); + (* Start an anonimous process that executes the procedure P *) + VAR newprocess: ProcessType; + BEGIN + Pop(free, newprocess); + IF newprocess = NIL THEN + NEW(newprocess); + ALLOCATE(newprocess^.wsp, WorkSpaceSize) + END; + WITH newprocess^ DO + father := cp; + sons := 0; + msglen := 0; + NEWPROCESS(P, wsp, WorkSpaceSize, cor) + END; + cp^.sons := cp^.sons + 1; + Push(newprocess, ready) + END StartProcess; + + PROCEDURE StopProcess; + (* Terminate a Process (itself) *) + VAR aux: ProcessType; + BEGIN + aux := cp^.father; + aux^.sons := aux^.sons - 1; + IF aux^.sons = 0 THEN + Push(aux, ready) + END; + aux := cp; + Push(aux, free); + Pop(ready, cp); + IF cp = NIL THEN + HALT + ELSE + TRANSFER(aux^.cor, cp^.cor) + END + END StopProcess; + + PROCEDURE InitChannel(VAR ch: Channel); + (* Initialize the channel ch *) + BEGIN + NEW(ch); + WITH ch^ DO + InitQueue(senders); + owner := NIL; + next := NIL; + guardindex := 0 + END + END InitChannel; + + PROCEDURE GetChannel(ch: Channel); + (* Assign the channel ch to the process that gets it *) + BEGIN + WITH ch^ DO + IF owner # NIL THEN + Traps.Message("Channel already has an owner"); + HALT + END; + owner := cp + END + END GetChannel; + + PROCEDURE Send(data: ARRAY OF BYTE; VAR ch: Channel); + (* Send a message with the data to the cvhannel ch *) + VAR m: ByteAddress; + aux: ProcessType; + i: CARDINAL; + BEGIN + WITH ch^ DO + Push(cp, senders); + ALLOCATE(cp^.msgadr, SIZE(data)); + m := cp^.msgadr; + cp^.msglen := HIGH(data); + FOR i := 0 TO HIGH(data) DO + m^ := data[i]; + m := ADDRESS(m) + 1 + END; + IF guardindex # 0 THEN + owner^.guardindex := guardindex; + CloseChannels(owner); + Push(owner, ready) + END + END; + DoTransfer + END Send; + + PROCEDURE Receive(VAR ch: Channel; VAR dest: ARRAY OF BYTE); + (* Receive a message from the channel ch into the dest variable *) + VAR aux: ProcessType; + m: ByteAddress; + i: CARDINAL; + BEGIN + WITH ch^ DO + IF cp # owner THEN + Traps.Message("Only owner of channel can receive from it"); + HALT + END; + IF Sending(ch) THEN + Pop(senders, aux); + m := aux^.msgadr; + FOR i := 0 TO aux^.msglen DO + dest[i] := m^; + m := ADDRESS(m) + 1 + END; + Push(aux, ready); + Push(cp, ready); + CloseChannels(cp) + ELSE + OpenChannel(ch, -1); + DoTransfer; + Pop(senders, aux); + m := aux^.msgadr; + FOR i := 0 TO aux^.msglen DO + dest[i] := m^; + m := ADDRESS(m) + 1 + END; + Push(cp, ready); + Push(aux, ready) + END; + DEALLOCATE(aux^.msgadr, aux^.msglen+1); + DoTransfer + END + END Receive; + + PROCEDURE SELECT(n: CARDINAL); + (* Beginning of a SELECT structure with n guards *) + BEGIN + cp^.guardindex := Uniform(1,n); + cp^.guardno := n; + cp^.guardcount := n + END SELECT; + + PROCEDURE NEXTGUARD(): CARDINAL; + (* Returns an index to the next guard to be evaluated in a SELECT *) + BEGIN + RETURN cp^.guardindex + END NEXTGUARD; + + PROCEDURE GUARD(cond: BOOLEAN; ch: Channel; + VAR dest: ARRAY OF BYTE): BOOLEAN; + (* Evaluates a guard, including reception management *) + VAR aux: ProcessType; + BEGIN + IF NOT cond THEN + RETURN FALSE + ELSIF ch = NIL THEN + CloseChannels(cp); + cp^.guardindex := 0; + RETURN TRUE + ELSIF Sending(ch) THEN + Receive(ch, dest); + cp^.guardindex := 0; + RETURN TRUE + ELSE + OpenChannel(ch, cp^.guardindex); + RETURN FALSE + END + END GUARD; + + PROCEDURE ENDSELECT(): BOOLEAN; + (* End of a SELECT structure *) + BEGIN + WITH cp^ DO + IF guardindex <= 0 THEN + RETURN TRUE + END; + guardcount := guardcount - 1; + IF guardcount # 0 THEN + guardindex := (guardindex MOD INTEGER(guardno)) + 1 + ELSIF ThereAreOpenChannels() THEN + DoTransfer + ELSE + guardindex := 0 + END + END; + RETURN FALSE + END ENDSELECT; + +BEGIN + InitQueue(free); + InitQueue(ready); + NEW(cp); + WITH cp^ DO + sons := 0; + father := NIL + END +END CSP. + diff --git a/lang/m2/libm2/LIST b/lang/m2/libm2/LIST index 2a359a1ea..17b8c69a2 100644 --- a/lang/m2/libm2/LIST +++ b/lang/m2/libm2/LIST @@ -1,4 +1,5 @@ tail_m2.a +CSP.mod PascalIO.mod RealInOut.mod InOut.mod diff --git a/lang/m2/libm2/Makefile b/lang/m2/libm2/Makefile index 445237e26..1276d8aa9 100644 --- a/lang/m2/libm2/Makefile +++ b/lang/m2/libm2/Makefile @@ -5,7 +5,7 @@ SOURCES = ASCII.def EM.def MathLib0.def Processes.def \ RealInOut.def Storage.def Arguments.def Conversion.def \ random.def Semaphores.def Unix.def RealConver.def \ Strings.def InOut.def Terminal.def TTY.def \ - Mathlib.def PascalIO.def Traps.def + Mathlib.def PascalIO.def Traps.def CSP.def all: diff --git a/lang/m2/libm2/catch.c b/lang/m2/libm2/catch.c index c1e4c70c4..3ee3d1d78 100644 --- a/lang/m2/libm2/catch.c +++ b/lang/m2/libm2/catch.c @@ -1,4 +1,5 @@ #include +#include static struct errm { int errno; @@ -29,8 +30,9 @@ static struct errm { { EBADLIN, "argument if LIN too high"}, { EBADGTO, "GTO descriptor error"}, - { 64, "stack size of process too large"}, - { 65, "too many nested traps + handlers"}, + { M2_TOOLARGE, "stack size of process too large"}, + { M2_TOOMANY, "too many nested traps + handlers"}, + { M2_NORESULT, "no RETURN from procedure function"}, { -1, 0} }; diff --git a/lang/m2/libm2/confarray.c b/lang/m2/libm2/confarray.c index c0eee3e35..0226a32b8 100644 --- a/lang/m2/libm2/confarray.c +++ b/lang/m2/libm2/confarray.c @@ -1,3 +1,5 @@ +#include + struct descr { char *addr; int low; @@ -17,7 +19,7 @@ _new_stackptr(pdescr, a) if (ppdescr >= &descrs[10]) { /* to many nested traps + handlers ! */ - TRP(65); + TRP(M2_TOOMANY); } *ppdescr++ = pdescr; if ((char *) &a - (char *) &size > 0) { diff --git a/lang/m2/libm2/head_m2.e b/lang/m2/libm2/head_m2.e index e5f4f6ccf..00b7f431d 100644 --- a/lang/m2/libm2/head_m2.e +++ b/lang/m2/libm2/head_m2.e @@ -20,7 +20,7 @@ mes 2,EM_WSIZE,EM_PSIZE -#define STACKSIZE 1024 /* maximum stack size for a coroutine */ +#define STACKSIZE 2048 /* maximum stack size for a coroutine */ exa _environ exa _argv diff --git a/lang/m2/libm2/random.mod b/lang/m2/libm2/random.mod index 69aa9fa91..86c2a65ee 100644 --- a/lang/m2/libm2/random.mod +++ b/lang/m2/libm2/random.mod @@ -1,11 +1,17 @@ IMPLEMENTATION MODULE random; -VAR seed: CARDINAL; +FROM Unix IMPORT getpid, time; +TYPE index = [0..54]; + +VAR X: ARRAY index OF CARDINAL; + k, j: index; PROCEDURE Random(): CARDINAL; BEGIN - seed := seed * 77 + 153; - RETURN seed; + IF k+1 > 54 THEN k := 0; ELSE INC(k) END; + IF j+1 > 54 THEN j := 0; ELSE INC(j) END; + X[k] := X[k] + X[j]; + RETURN X[k] END Random; PROCEDURE Uniform (lwb, upb: CARDINAL): CARDINAL; @@ -15,5 +21,11 @@ BEGIN END Uniform; BEGIN - seed := 253B; + X[0] := time(NIL); + X[0] := CARDINAL(getpid()) * X[0]; + FOR k := 1 TO 54 DO + X[k] := X[k-1] * 1297; + END; + k := 54; + j := 30; END random. diff --git a/lang/m2/libm2/transfer.e b/lang/m2/libm2/transfer.e index 08a90e6a1..e3b388edd 100644 --- a/lang/m2/libm2/transfer.e +++ b/lang/m2/libm2/transfer.e @@ -1,5 +1,6 @@ # #include +#include mes 2, EM_WSIZE, EM_PSIZE @@ -230,7 +231,7 @@ _target loe _StackSize cmu EM_WSIZE zle *1 - loc 64 ; trap number for "stack size too large" + loc M2_TOOLARGE ; trap number for "stack size too large" trp 1 lol 0