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
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
|
(*
**********************************************************
**********************************************************
** **
** ls-Warenhaus 1 **
** **
** Version 1.01 **
** **
** **
** (Stand: 30.08.89) **
** **
** **
** **
** Autor: Bruno Pollok, Bielefeld **
** **
** Copyright (C) 1988 Eva Latta-Weber, Bielefeld **
** Copyright (C) 1990 ERGOS GmbH, Siegburg **
** **
**********************************************************
**********************************************************
*)
PACKET monitor alt DEFINES original monitor:
PROC original monitor:
monitor
END PROC originalmonitor
END PACKET monitor alt;
PACKET ls warenhaus 1 DEFINES
zentrale,
monitor,
warenhaus direktstart,
warenhaus hauptstelle,
hauptstellenname:
LET max kundenzahl = 31,
min kundennummer = 129,
kundendatei holen code = 100,
kundendatei ergaenzen code = 200;
TYPE KUNDENDATEN = STRUCT (TEXT nachname, vorname, geschlecht),
KUNDENDATEI = ROW max kundenzahl KUNDENDATEN;
BOUND KUNDENDATEN VAR kundendaten;
BOUND KUNDENDATEI VAR bound kundendatei;
KUNDENDATEI VAR kundendatei;
DATASPACE VAR ds;
TASK VAR absender,
zentraltask :: niltask,
hauptstelle :: niltask,
direktstartmanager :: niltask;
BOOL VAR mit direktstart :: FALSE,
mit loeschen :: FALSE;
INT VAR codenummer;
PROC zentrale:
enable stop;
IF pos (name (myself), ".Zentrale") = 0
THEN errorstop ("Unzulaessiger Befehl!")
FI;
disable stop;
REP wait (ds, codenummer, absender);
bearbeite auftrag;
send (absender, codenummer, ds);
IF is error THEN clear error FI
PER.
bearbeite auftrag:
IF codenummer = kundendatei holen code
THEN hole kundendatei
ELIF codenummer = kundendatei ergaenzen code
THEN ergaenze kundendatei
ELIF codenummer >= min kundennummer
THEN lies kundendaten
ELSE speichere kundendaten
FI.
END PROC zentrale;
PROC hole kundendatei:
bound kundendatei := ds;
bound kundendatei := kundendatei
END PROC hole kundendatei;
PROC ergaenze kundendatei:
INT VAR kundennummer;
bound kundendatei := ds;
FOR kundennummer FROM 1 UPTO max kundenzahl REP
IF kundendatei [kundennummer].nachname = ""
THEN kundendatei [kundennummer] := bound kundendatei [kundennummer]
FI
PER;
init ds
END PROC ergaenze kundendatei;
PROC lies kundendaten:
kundendaten := ds;
kundendaten := kundendatei [platznummer].
platznummer: codenummer - min kundennummer + 1.
END PROC lies kundendaten;
PROC speichere kundendaten:
kundendaten := ds;
kundendatei [codenummer] := kundendaten;
init ds
END PROC speichere kundendaten;
PROC warenhaus hauptstelle (BOOL CONST task soll hauptstelle sein):
enable stop;
IF task soll hauptstelle sein
THEN mache task zur hauptstelle
ELSE mache hauptstellenstatus rueckgaengig
FI.
mache task zur hauptstelle:
sei eine hauptstelle;
line (2);
IF NOT mit direktstart CAND yes ("Mit Direktstart")
THEN warenhaus direktstart (TRUE)
ELSE global manager
FI
END PROC warenhaus hauptstelle;
PROC sei eine hauptstelle:
IF NOT (hauptstelle = niltask OR hauptstelle = myself)
THEN errorstop ("Hauptstelle ist bereits die Task '" +
name (hauptstelle) + "'!")
FI;
disable stop;
end (zentraltask);
IF is error THEN clear error FI;
enable stop;
hauptstelle := niltask;
begin (name (myself) + ".Zentrale", PROC zentrale, zentraltask);
hauptstelle := myself
END PROC sei eine hauptstelle;
PROC mache hauptstellenstatus rueckgaengig:
IF NOT (hauptstelle = niltask OR hauptstelle = myself)
THEN errorstop ("Dieses Kommando darf nur in der Task '" +
name (hauptstelle) + " gegeben werden!")
FI;
disable stop;
end (zentraltask);
IF is error THEN clear error FI;
enable stop;
hauptstelle := niltask;
warenhaus direktstart (FALSE)
END PROC mache hauptstellenstatus rueckgaengig;
PROC warenhaus direktstart (BOOL CONST wahl):
pruefe zulaessigkeit;
mit direktstart := wahl;
IF mit direktstart
THEN direktstartmanager := myself;
mit loeschen := yes ("Mit automatischem Löschen")
ELSE direktstartmanager := niltask
FI;
global manager.
pruefe zulaessigkeit:
enable stop;
IF NOT (direktstartmanager = niltask OR direktstartmanager = myself)
THEN errorstop ("Der Direktstart kann nur aus der Task '" +
name (direktstartmanager) + "'geaendert werden!")
FI.
END PROC warenhaus direktstart;
TEXT PROC hauptstellenname:
name (hauptstelle)
END PROC hauptstellenname;
PROC monitor:
IF mit direktstart
THEN warenhaus monitor
ELSE original monitor
FI
END PROC monitor;
PROC warenhausmonitor:
disable stop;
INT VAR previous heapsize := heap size;
REP command dialogue (TRUE);
sysin (""); sysout ("");
cry if not enough storage;
reset dialog; erase menunotice;
do ("warenhaus");
IF is error
THEN clear error
ELSE sitzungsende
FI
PER.
sitzungsende:
collect heap garbage if necessary;
page;
IF mit loeschen
THEN break; end (myself)
ELSE end; break
FI.
collect heap garbage if necessary:
IF heap size > previous heapsize + 10
THEN collect heap garbage;
previous heapsize := heap size
FI.
cry if not enough storage:
INT VAR size, used;
storage (size, used);
IF used > size
THEN out (""7"Speicher Engpass! Dateien loeschen!"13""10"")
FI.
END PROC warenhausmonitor;
OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle):
CONCR (ziel) := CONCR (quelle)
END OP :=;
OP := (KUNDENDATEI VAR ziel, KUNDENDATEI CONST quelle):
CONCR (ziel) := CONCR (quelle)
END OP :=;
PROC init ds:
forget (ds); ds := nilspace
END PROC init ds;
PROC initialisiere kundendatei:
KUNDENDATEN CONST leer :: KUNDENDATEN : ("", "", "");
INT VAR nr;
FOR nr FROM 1 UPTO max kundenzahl REP
kundendatei [nr] := leer
PER
END PROC initialisiere kundendatei;
initialisiere kundendatei
END PACKET ls warenhaus 1
|
