1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
|
PACKET eudas manager (* Autor: Thomas Berlage *)
(* Stand: 20.01.88 *)
DEFINES
eudas manager,
setze partner,
abhaengige task,
end partner :
LET
code dateien = 190,
code felder = 191,
code positioniere = 192,
code satz = 193,
end myself code = 197,
set controlled code = 198,
ask partner code = 200;
LET
ack = 0;
LET
COM = STRUCT (INT int info,
BOOL bool info,
TEXT text info,
SATZ satz info);
BOUND COM VAR p;
ROW 4 TEXT VAR partner vater;
partner vater (1) := "";
partner vater (2) := "";
partner vater (3) := "";
partner vater (4) := "";
TEXT VAR puffer;
LET
kein partner =
"Kein Partner";
PROC setze partner (INT CONST nr, TEXT CONST name des vaters) :
partner vater (nr) := name des vaters
END PROC setze partner;
PROC eudas manager (DATASPACE VAR ds, INT CONST order, phase,
TASK CONST order task) :
enable stop;
SELECT order OF
CASE code dateien : code dateien ausfuehren
CASE code felder : code felder ausfuehren
CASE code positioniere : code positioniere ausfuehren
CASE code satz : code satz ausfuehren
OTHERWISE andere codes
END SELECT .
andere codes :
IF order > ask partner code AND order < ask partner code + 4 THEN
ask partner code ausfuehren
ELSE
menue manager (ds, order, phase, order task)
END IF .
code dateien ausfuehren :
p := ds;
p. int info := dateiversion;
dateinamen anlegen;
send (order task, ack, ds) .
dateinamen anlegen :
satz initialisieren (p. satz info);
FOR i FROM 1 UPTO anzahl dateien REP
feld aendern (p. satz info, i, eudas dateiname (i))
END REP .
code felder ausfuehren :
p := ds;
feldinfo anlegen;
feldnamen anlegen;
send (order task, ack, ds) .
feldinfo anlegen :
INT VAR i;
TEXT VAR rep := " ";
p. text info := "";
FOR i FROM 1 UPTO anzahl felder REP
replace (rep, 1, feldinfo (i));
p. text info CAT rep
END REP .
feldnamen anlegen :
satz initialisieren (p. satz info, anzahl felder);
FOR i FROM 1 UPTO anzahl felder REP
feldnamen lesen (i, puffer);
feld aendern (p. satz info, i, puffer)
END REP .
code positioniere ausfuehren :
p := ds;
positionieren;
ergebnis ablegen;
send (order task, ack, ds) .
positionieren :
IF p. bool info THEN
relativ positionieren
ELSE
auf satz (p. int info)
END IF .
relativ positionieren :
IF p. int info > 0 THEN
weiter (p. int info)
ELIF p. int info < 0 THEN
zurueck (- p. int info)
END IF .
ergebnis ablegen :
p. int info := satznummer;
p. bool info := dateiende .
code satz ausfuehren :
p := ds;
p. int info := satzkombination;
p. bool info := satz ausgewaehlt;
satz aufbauen;
send (order task, ack, ds) .
satz aufbauen :
satz initialisieren (p. satz info, anzahl felder);
FOR i FROM 1 UPTO anzahl felder REP
feld lesen (i, puffer);
feld aendern (p. satz info, i, puffer)
END REP .
ask partner code ausfuehren :
INT VAR p nr := order - ask partner code;
forget (ds); ds := nilspace;
BOUND TASK VAR c task := ds;
CONCR (c task) := partner mit einrichten (p nr, task index);
send (order task, ack, ds) .
task index :
FOR i FROM 2 UPTO 4 REP
IF partner task (i) = order task THEN
LEAVE task index WITH i
END IF
END REP;
errorstop (kein partner);
1 .
END PROC eudas manager;
TASK PROC abhaengige task (INT CONST p nr) :
partner mit einrichten (p nr, 1)
END PROC abhaengige task;
TASK PROC partner mit einrichten (INT CONST p nr, p von) :
enable stop;
IF NOT exists (partner task (p nr)) THEN
partner einrichten
END IF;
partner task (p nr) .
partner einrichten :
TEXT CONST neuer name := name (myself) + "-p" + text (p nr - 1);
begin (neuer name, partner vater (p nr));
partner task (p nr, task (neuer name));
abhaengig setzen .
abhaengig setzen :
DATASPACE VAR send ds := nilspace;
BOUND STRUCT (INT von, TASK pt) VAR m := send ds;
m. von := p von;
m. pt := partner task (p von);
INT VAR i, reply;
FOR i FROM 1 UPTO 5 REP
pingpong (partner task (p nr), set controlled code, send ds, reply);
IF reply = -2 THEN pause (5) END IF
UNTIL reply <> -2 END REP;
forget (send ds) .
END PROC partner mit einrichten;
PROC end partner (INT CONST p nr) :
IF exists (partner task (p nr)) THEN
end code senden
END IF .
end code senden :
DATASPACE VAR send ds := nilspace;
INT VAR i, reply;
FOR i FROM 1 UPTO 10 REP
send (partner task (p nr), end myself code, send ds, reply);
IF reply = ack THEN
LEAVE end code senden
END IF;
pause (3)
END REP;
forget (send ds);
errorstop ("END nicht angenommen") .
END PROC end partner;
END PACKET eudas manager;
|
