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
|
(*
**********************************************************
**********************************************************
** **
** ls-Warenhaus 0 **
** **
** Anpassung für Kartenleser an AKTRONIC-Adapter **
** **
** 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 ls warenhaus 0 DEFINES
interface anpassung,
oeffne interface,
schliesse interface,
wert von interface,
pressed key,
(* --------------------------- *)
kanalkoppler,
interfacechannel,
init interfacechannel:
TEXT CONST interface anpassung :: "mit Kartenleser an AKTRONIC-Adapter";
LET max channel = 24,
initcode = 26,
endcode = 27,
read code = 28;
INT CONST nicht initialisiert code :: -3,
interface error code :: -4,
kanal besetzt code :: -5;
INT VAR interfacekanal :: 0;
TEXT VAR puffer :: "";
TASK VAR hardwaremanager :: niltask,
interface task :: niltask,
absender;
DATASPACE VAR ds :: nilspace;
INT PROC interfacechannel:
interfacekanal
END PROC interfacechannel;
PROC oeffne interface (INT VAR status):
puffer := "";
forget (ds); ds := nilspace;
pingpong (interfacetask, init code, ds, status);
IF status > 0 THEN status DECR maxint FI;
forget (ds); ds := nilspace
END PROC oeffne interface;
INT PROC wert von interface:
INT VAR wert;
puffer CAT incharety (1);
call (interface task, read code, ds, wert);
wert.
END PROC wert von interface;
PROC schliesse interface:
forget (ds); ds := nilspace;
send (interface task, end code, ds);
forget (ds); ds := nilspace
END PROC schliesse interface;
TEXT PROC pressed key:
IF puffer = ""
THEN incharety
ELSE erstes pufferzeichen
FI.
erstes pufferzeichen:
TEXT VAR zeichen :: puffer SUB 1;
puffer := subtext (puffer, 2);
zeichen.
END PROC pressed key;
TEXT PROC pressed key (INT CONST warten):
IF puffer = ""
THEN incharety (warten)
ELSE erstes pufferzeichen
FI.
erstes pufferzeichen:
TEXT VAR zeichen :: puffer SUB 1;
puffer := subtext (puffer, 2);
zeichen.
END PROC pressed key;
(*************************************************************************)
PROC kanalkoppler:
enable stop;
IF name (myself) <> "-"
THEN errorstop ("Unzulässiges Kommando!")
ELSE warte auf anrufe
FI.
warte auf anrufe:
INT VAR codenummer, antwort;
disable stop;
REP wait (ds, codenummer, absender);
reagiere auf anruf;
loesche ggf fehlerzustand
PER.
reagiere auf anruf:
IF codenummer = initcode
THEN kopple an interface;
IF interface ist betriebsbereit
THEN bearbeite weitere auftraege
ELSE gib negative rueckmeldung
FI;
gib kanal frei
ELSE send (absender, nicht initialisiert code, ds)
FI.
loesche ggf fehlerzustand:
IF is error
THEN clear error
FI.
kopple an interface:
IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself
THEN antwort := kanal besetzt code;
ELSE continue (interfacekanal);
teste interface
FI.
teste interface:
leere puffer;
out (""240"");
IF incharety (1) <> ""
THEN antwort := 0;
out (""176"")
ELSE antwort := interface error code
FI.
leere puffer:
REP UNTIL incharety = "" PER.
interface ist betriebsbereit: antwort = 0.
gib negative rueckmeldung: send (absender, antwort, ds).
gib kanal frei: break (quiet).
ende: out (""176"").
bearbeite weitere auftraege:
REP pingpong (absender, antwort, ds, codenummer);
IF codenummer = read code
THEN hole wert von interface
ELIF codenummer < 0
THEN send (absender, codenummer, ds);
codenummer := endcode
ELSE antwort := 0
FI
UNTIL codenummer = endcode PER;
ende.
hole wert von interface:
out (""211"");
antwort := code (incharety (1)).
END PROC kanalkoppler;
PROC init interfacechannel:
teste auf zulaessigkeit;
loesche interfacetask;
erfrage interface kanal;
generiere ggf neue interfacetask.
teste auf zulaessigkeit:
enable stop;
IF hardwaremanager <> niltask AND hardwaremanager <> myself
THEN errorstop ("Dieses Kommando kann nur von der Task '" +
name (hardwaremanager) + "' aus gegeben werden!")
ELSE hardwaremanager := myself
FI.
loesche interfacetask:
disable stop;
end (interfacetask);
IF is error THEN clear error FI;
enable stop.
generiere ggf neue interfacetask:
IF interface kanal = 0
THEN interface task := niltask;
hardwaremanager := niltask
ELSE begin (PROC kanalkoppler, interface task);
hardwaremanager := myself
FI.
erfrage interfacekanal:
INT VAR kanalnummer;
put ("Gib Interface - Kanal:");
get (kanalnummer);
set interfacechannel (kanalnummer).
END PROC init interfacechannel;
PROC set interface channel (INT CONST channel number):
IF channel number < 0 OR channel number > max channel
THEN errorstop ("Unzulässige Kanalnummer")
ELSE interfacekanal := channel number
FI
END PROC set interface channel;
BOOL OP <> (TASK CONST t1, t2):
NOT (t1 = t2)
END OP <>;
init interfacechannel
END PACKET ls warenhaus 0
|
