1% $Id: simulation.sim,v 1.4 1997/02/14 16:33:03 cim Exp $
2
3
4% Copyright (C) 1994 Sverre Hvammen Johansen and Stein Krogdahl,
5% Department of Informatics, University of Oslo.
6%
7% This program is free software; you can redistribute it and/or modify
8% it under the terms of the GNU General Public License as published by
9% the Free Software Foundation; version 2.
10%
11% This program is distributed in the hope that it will be useful,
12% but WITHOUT ANY WARRANTY; without even the implied warranty of
13% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14% GNU General Public License for more details.
15%
16% You should have received a copy of the GNU General Public License
17% along with this program; if not, write to the Free Software
18% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20%ifdef included
21%else
22%timestamp simulation
23%endif
24% nameasvar on
25%nonetest off
26%casesensitive on
27SIMSET CLASS SIMULATION;
28BEGIN
29  REF(PROCESS) zzsqs;
30
31  REF(zzmain_program)MAIN;
32
33  REF(PROCESS) PROCEDURE CURRENT; CURRENT:-zzsqs.zzsqssuc;
34
35  LONG REAL PROCEDURE TIME; TIME:=zzsqs.zzsqssuc.zzevtime;
36
37  LINK CLASS PROCESS;
38  BEGIN
39    ! From event notice: ;
40    REF(PROCESS) zzsqssuc, zzsqspred;
41    LONG REAL zzevtime;
42
43    ! From old process: ;
44    BOOLEAN zzterminated_process;
45
46    BOOLEAN PROCEDURE IDLE; IDLE:= (zzsqssuc==NONE);
47
48    BOOLEAN PROCEDURE TERMINATED; TERMINATED:=zzterminated_process;
49
50    LONG REAL PROCEDURE EVTIME;
51      IF  zzsqssuc==NONE THEN ERROR("No Evtime for idle process")
52      ELSE EVTIME:= zzevtime;
53
54    REF(PROCESS) PROCEDURE NEXTEV;
55      NEXTEV:-IF zzsqssuc==NONE OR ELSE zzsqssuc==zzsqs THEN NONE
56        ELSE zzsqssuc;
57
58    ! Not necessary: ;  zzsqssuc:- zzsqspred:- NONE;
59
60    DETACH;
61    INNER;
62    zzterminated_process:=TRUE;
63
64    ! Remove from SQS: ;
65    zzsqssuc.zzsqspred:- zzsqspred;
66    zzsqspred.zzsqssuc:- zzsqssuc;
67    zzsqspred:- zzsqssuc:- NONE;
68
69    IF zzsqs.zzsqssuc==zzsqs THEN ERROR("SQS: Empty")
70                             ELSE RESUME(zzsqs.zzsqssuc);
71
72    ERROR("SQS: Terminated process");
73  END PROCESS;
74
75  PROCEDURE activat(REAC,X,CODE,T,Y,PRIO);
76    REF(PROCESS)X,Y;
77    BOOLEAN REAC,PRIO;
78    CHARACTER CODE;
79    LONG REAL T;
80  BEGIN
81    REF(PROCESS) b, cur;
82    LONG REAL tm;
83
84    IF X =/= NONE AND THEN NOT X.zzterminated_process
85       AND THEN (REAC OR ELSE X.zzsqssuc == NONE) THEN
86    BEGIN
87      cur:- zzsqs.zzsqssuc; tm:=cur.zzevtime;
88
89      IF CODE = '!1!' THEN
90      BEGIN ! Direct ;
91         IF X==cur THEN GOTO exit;
92         T:=tm; b:- zzsqs;
93      END ELSE
94      IF CODE = '!2!' THEN
95      BEGIN !At;
96         IF T<=tm THEN
97         BEGIN IF PRIO AND THEN X==cur THEN GOTO exit ELSE T:=tm END;
98      END ELSE
99      IF CODE = '!3!' THEN
100      BEGIN !Delay;
101         T:= T+tm;
102         IF T<=tm THEN
103         BEGIN IF PRIO AND THEN X==cur THEN GOTO exit ELSE T:=tm END;
104      END ELSE
105      ! CODE = '!4!' OR CODE = '!5!' ;
106      BEGIN ! 4=Before, 5=After ;
107         IF Y==NONE OR ELSE Y.zzsqssuc==NONE THEN
108         BEGIN
109            IF X.zzsqssuc=/=NONE THEN
110            BEGIN
111              X.zzsqssuc.zzsqspred:- X.zzsqspred;
112              X.zzsqspred.zzsqssuc:- X.zzsqssuc;
113              X.zzsqspred:- NONE; X.zzsqssuc:- NONE;
114            END;
115
116            IF zzsqs.zzsqssuc==zzsqs THEN ERROR("SQS: Empty");
117            GOTO exit;
118         END;
119
120         IF X==Y THEN GOTO exit;
121
122         T:= Y.zzevtime;
123
124         IF CODE = '!4!' THEN b:- Y.zzsqspred ELSE b:- Y;
125       END;
126
127       IF X.zzsqssuc =/= NONE THEN
128       BEGIN
129           X.zzsqssuc.zzsqspred:- X.zzsqspred;
130           X.zzsqspred.zzsqssuc:- X.zzsqssuc;
131       END;
132
133       IF b==NONE THEN
134       BEGIN ! Not `direct', `after' or `before' ;
135          b:- zzsqs.zzsqspred;
136          WHILE b.zzevtime>T DO b:- b.zzsqspred;
137          IF PRIO THEN
138            WHILE b.zzevtime=T DO b:- b.zzsqspred;
139       END;
140
141       X.zzevtime:= T;
142       X.zzsqspred:- b; X.zzsqssuc:- b.zzsqssuc;
143       b.zzsqssuc:- X; X.zzsqssuc.zzsqspred:- X;
144
145       IF zzsqs.zzsqssuc=/=cur THEN RESUME(zzsqs.zzsqssuc);
146    END;
147  exit:
148  END activat;
149
150  PROCEDURE HOLD(t);
151    LONG REAL t;
152  BEGIN
153    REF(PROCESS) p,q; p:- zzsqs.zzsqssuc;
154    IF t>0 THEN p.zzevtime:= p.zzevtime + t;
155    t:= p.zzevtime;  ! New evtime ;
156    IF p.zzsqssuc=/=zzsqs AND THEN p.zzsqssuc.zzevtime<=t THEN
157    BEGIN
158        p.zzsqssuc.zzsqspred:- p.zzsqspred;
159        p.zzsqspred.zzsqssuc:- p.zzsqssuc;
160
161        q:- zzsqs.zzsqspred;
162        WHILE q.zzevtime>t DO q:- q.zzsqspred;
163
164        p.zzsqspred:- q; p.zzsqssuc:- q.zzsqssuc;
165        q.zzsqssuc:- p; p.zzsqssuc.zzsqspred:- p;
166
167        RESUME(zzsqs.zzsqssuc);
168    END IF;
169  END HOLD;
170
171  PROCEDURE PASSIVATE;
172  BEGIN
173     REF(PROCESS) p; p:- zzsqs.zzsqssuc;
174     p.zzsqssuc.zzsqspred:- p.zzsqspred;
175     p.zzsqspred.zzsqssuc:- p.zzsqssuc;
176     p.zzsqspred:- NONE; p.zzsqssuc:- NONE;
177
178     IF zzsqs.zzsqssuc==zzsqs THEN ERROR("SQS: Empty")
179                              ELSE RESUME(zzsqs.zzsqssuc);
180  END PASSIVATE;
181
182  PROCEDURE WAIT(S);REF(HEAD)S;
183  BEGIN
184     REF(PROCESS) p; p:- zzsqs.zzsqssuc;
185     p.INTO(S); ! May also be expanded inline ;
186
187     p.zzsqssuc.zzsqspred:- p.zzsqspred;
188     p.zzsqspred.zzsqssuc:- p.zzsqssuc;
189     p.zzsqspred:- NONE; p.zzsqssuc:- NONE;
190
191     IF zzsqs.zzsqssuc==zzsqs THEN ERROR("SQS: Empty")
192                              ELSE RESUME(zzsqs.zzsqssuc);
193  END WAIT;
194
195  PROCEDURE CANCEL(x); REF(PROCESS)x;
196  BEGIN
197     REF(PROCESS) cur;
198     IF x=/=NONE AND THEN x.zzsqssuc=/=NONE THEN
199     BEGIN
200        cur:- zzsqs.zzsqssuc;
201        x.zzsqssuc.zzsqspred:- x.zzsqspred;
202        x.zzsqspred.zzsqssuc:- x.zzsqssuc;
203        x.zzsqspred:- NONE; x.zzsqssuc:- NONE;
204
205        IF x==cur THEN
206        BEGIN
207           IF zzsqs.zzsqssuc==zzsqs THEN ERROR("SQS: Empty")
208                                    ELSE RESUME(zzsqs.zzsqssuc);
209        END;
210     END;
211  END CANCEL;
212
213  PROCESS CLASS zzmain_program;
214  BEGIN
215    WHILE TRUE DO DETACH
216  END MAIN_PROGRAM;
217
218  PROCEDURE ACCUM(A,B,C,D);NAME A,B,C;
219    LONG REAL A,B,C,D;
220  BEGIN
221    A:=A+C*(TIME-B); B:=TIME; C:=C+D;
222  END ACCUM;
223
224  zzsqs:- NEW PROCESS; zzsqs.zzevtime:= -1;
225
226  MAIN:- NEW zzmain_program;
227  zzsqs.zzsqssuc:- MAIN; zzsqs.zzsqspred:- MAIN;
228  MAIN.zzsqssuc:- zzsqs; MAIN.zzsqspred:- zzsqs;
229
230END SIMULATION;
231
232%CASESENSITIVE OFF
233%eof
234