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
236
237
238
239
240
241
242
243
244
245
246
|
(* COPYRIGHT: digitron GmbH, Bielefeld 1989 *)
(*
EUMEL0:
modul: 2047 start: 3 0 code: 3 0 1 -257 32604 32588 32573 3 32666 1
3 4 0 32667 2 3 4 0 3076 11268 5 28678 32573 6 32666 1 6 7 0 32667 2 6 7 0
3079 11271 8 28694 32573 9 32666 1 9 10 0 32667 2 9 10 0 3082 11274 11 28710
32573 12 32666 1 12 13 0 32667 2 12 13 0 3085 11277 14 28726 32573 15 32666
1 16 17 18 32592 17 19 32666 1 22 18 0 32667 2 22 19 0 3090 3091 3092 11284
21 28750 32587 32583 1 32512 endc pbase: -256 0 0 0 0 1792 -256 1 0 0 3 256
0 5 0 -32768 9999 7 25 0 0 0 4 1 endp
*)
PACKET ds accesses DEFINES
do,
ds nr,
forget all but not,
set modul start ic,
read ds,
write ds,
:
INT CONST stdds := 4 + index(myself) * 256;
INT PROC read ds (INT CONST drid, add hi, add lo):
EXTERNAL 154
END PROC read ds;
INT PROC read ds (DATASPACE CONST drid, INT CONST add hi, add lo):
EXTERNAL 154
END PROC read ds;
PROC write ds (INT CONST drid, add hi, add lo, data):
EXTERNAL 155
END PROC write ds;
PROC write ds (DATASPACE CONST drid, INT CONST add hi, add lo, data):
EXTERNAL 155
END PROC write ds;
PROC forget (INT CONST ds):
EXTERNAL 71
END PROC forget;
OP := (INT VAR left, DATASPACE CONST right):
EXTERNAL 260
END OP :=;
PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line,
INT VAR modul nr, BOOL CONST ins, lst, rt check, ser):
EXTERNAL 256
END PROC elan;
PROC do (INT CONST modul nr):
INT VAR modul no:= modul nr;
DATASPACE VAR source;
elan (4, source, "", modul no, FALSE, FALSE, FALSE, FALSE);
END PROC do;
INT PROC ds nr (TEXT CONST name):
INT VAR nr := old (name); nr
END PROC ds nr;
PROC forget all but not (INT CONST ds):
INT VAR i, a;
FOR i FROM 5 UPTO 255 REP
a := i + 256 * index (myself);
IF i <> ds MOD 256 THEN
cout (i); forget (a);
FI;
PER
END PROC forget all but not;
PROC set modul start ic (INT CONST modul nr, ic hi, ic lo):
IF ic hi < 2 OR ic hi > 3 THEN error stop ("Falscher Instruction Counter") FI;
IF (modul nr >= 1280 AND ic hi = 3) OR (modul nr <= 1280 AND ic hi = 2) THEN
write ds (stdds, 0, modul nr + 512, ic lo);
ELSE
error stop ("Falsche Modulnummer: " + text (modul nr));
FI;
END PROC set modul start ic;
END PACKET ds accesses;
PACKET lader DEFINES
lade,
:
INT CONST stdds := 4 + index (myself) * 256;
PROC check task index (TEXT CONST name):
IF index (myself) = index copytask (old(name)) THEN
putline ("Leider haben sie den gleichen Taskindex wie bei der Quelltask erwischt!");
errorstop("Bitte versuchen sie es mit einer neuen Task!");
FI;
END PROC check task index;
INT PROC index copytask (DATASPACE CONST ds):
read ds (ds, 7, 9)
END PROC index copytask;
PROC get ic (FILE VAR f, INT VAR ic hi, ic lo):
find text (f,"start:");
get int (f,ic hi); get int (f,ic lo);
IF ic hi <> 3 THEN error stop ("Falscher Start IC") FI;
END PROC get ic;
PROC get pbase (FILE VAR f, INT VAR ps):
find text (f, "pbase:");
get int (f, ps);
IF ps MOD 256 <> 0 THEN error stop ("Falsche Packet Basis") FI;
END PROC get pbase;
PROC get modul (FILE VAR f, INT VAR modul nr):
find text (f, "modul:");
get int (f, modul nr);
END PROC get modul;
PROC load code (FILE VAR f):
INT VAR add hi, add lo, code wert;
TEXT VAR code ende;
check end code (f);
get code add (f, add hi, add lo);
REP
get code (f, code wert, code ende);
IF code ende = "end" THEN LEAVE load code FI;
write ds (stdds, add hi, add lo, code wert);
add lo INCR 1;
PER
END PROC load code;
PROC load pbase (FILE VAR f):
INT VAR pbase add, pbase wert;
TEXT VAR pbase ende;
check end pbase (f);
get pbase (f, pbase add);
REP
get pbase (f, pbase wert, pbase ende);
IF pbase ende = "end" THEN LEAVE load pbase FI;
write ds (stdds, 0, pbase add, pbase wert);
pbase add INCR 1;
PER
END PROC load pbase;
INT PROC read pbase var (FILE VAR f, INT CONST index):
INT VAR pbase add;
get pbase (f, pbase add);
read ds (stdds, 0, pbase add+index)
END PROC read pbase var;
PROC write pbase var (FILE VAR f, INT CONST index, var):
INT VAR pbase add;
get pbase (f, pbase add);
write ds (stdds, 0, pbase add+index, var);
END PROC write pbase var;
PROC get code add (FILE VAR f, INT VAR add hi, add lo):
find text (f, "code:");
get int (f, add hi); get int (f, add lo);
IF add hi <> 3 THEN error stop ("Falsche Code-Adresse") FI;
END PROC get code add;
PROC get int (FILE VAR f, INT VAR value):
IF eof (f) THEN error stop ("Daten fehlen") FI;
TEXT VAR daten;
get (f, daten);
IF daten = "-32768" THEN
value := -maxint-1;
ELSE
value := int (daten);
ENDIF;
END PROC get int;
PROC get code (FILE VAR f, INT VAR value, TEXT VAR ende ):
IF eof(f) THEN error stop ("'End Code'-Kennung fehlt") FI;
TEXT VAR daten ;
get (f, daten);
IF daten = "endc" THEN
ende := "end"
ELSE
IF daten = "-32768" THEN
value := -maxint-1;
ELSE
value := int (daten);
ENDIF;
ende := "no end"
FI;
END PROC get code;
PROC check end code (FILE VAR f):
find text (f, "endc");
END PROC check end code;
PROC get pbase (FILE VAR f,INT VAR value, TEXT VAR ende):
IF eof (f) THEN error stop ("'End Pbase'-Kennung fehlt") FI;
TEXT VAR daten ;
get (f, daten);
IF daten = "endp" THEN
ende := "end"
ELSE
IF daten = "-32768" THEN
value := -maxint-1;
ELSE
value := int (daten);
ENDIF;
ende := "no end"
FI;
END PROC get pbase;
PROC check end pbase (FILE VAR f):
find text (f, "endp");
END PROC check end pbase;
PROC find text (FILE VAR f, TEXT CONST suchtext):
TEXT VAR t;
go start (f);
WHILE NOT eof (f) REP
get (f, t);
IF t = suchtext THEN LEAVE find text FI;
PER;
error stop (suchtext + " fehlt")
END PROC find text;
PROC go start (FILE VAR f):
TEXT VAR t;
reset (f);
WHILE NOT eof (f) REP
get (f, t);
IF t = "EUMEL0:" THEN LEAVE go start FI
PER;
error stop ("EUMEL0-Code nicht gefunden");
END PROC go start;
PROC run code (INT VAR ic hi, ic lo, modul nr):
set modul start ic (modul nr, ic hi, ic lo);
do push (modul nr);
END PROC run code;
PROC do push (INT CONST modul nr):
IF lbase < 30000 THEN
do push (modul nr);
ELSE
do (modul nr); LEAVE do push;
FI;
END PROC do push;
INT PROC lbase:
pcb (25)
END PROC lbase;
PROC lade (TEXT CONST datei name):
INT VAR ic hi, ic lo, modul nr;
line;
putline ("Achtung: ALLE bis jetzt insertierten Packete der Task gehen verloren!");
IF NOT yes ("Wollen sie den Standarddatenraum ersetzen") THEN LEAVE lade FI;
check task index (datei name);
FILE VAR f := sequentialfile (input, dateiname);
get ic (f, ic hi, ic lo);
get modul (f, modul nr);
load code (f);
load pbase (f);
load pbase var (f);
run code (ic hi, ic lo, modul nr);
END PROC lade;
PROC load pbase var (FILE VAR f):
INT VAR dss, dst; TEXT VAR name := "STD DS4";
line;
put ("Wie heißt der Quelldatenraum:");
editget (name);
line;
IF NOT exists (name) THEN errorstop("Datei " + name + " gibt es nicht."); FI;
dst := 4 + 256 * index (myself);
dss := ds nr (name);
write pbase var (f, 1, dss);
write pbase var (f, 2, dst);
forget all but not (dss);
END PROC load pbase var;
PROC lade:
lade ("RUN load ds4");
END PROC lade;
END PACKET lader;
lade;
|
