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
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
|
(* ------------------- VERSION 13 vom 28.05.86 -------------------- *)
PACKET macro store DEFINES macro command and then process parameters,
get macro line,
number macro lines,
load macros,
list macros:
(* Programm zur Behandlung von Textkosemtik-Macros
Autor: Rainer Hahn
Stand: 1.7.1 (Febr. 1984)
*)
INITFLAG VAR this packet :: FALSE;
DATASPACE VAR ds;
BOUND MACROTABLE VAR macro table;
FILE VAR f;
LET MACROTABLE = STRUCT (ROW max macros TEXT replacement store,
ROW max macro zeilen TEXT macro zeilen,
ROW max macros TEXT macro namen,
ROW max macros INT anz parameter,
ROW max macros INT macro start);
LET tag = 1,
number = 3,
delimiter = 6,
end of scan = 7,
max macro zeilen = 1000,
max macros = 200;
INT VAR index aktuelle macro zeile,
type,
anz zeilen in macro,
anz macro zeilen,
anz macros :: 0;
TEXT VAR symbol,
fehlertext,
dummy,
kommando,
zeile;
BOOL VAR with parameters,
macro end gewesen;
PROC init macros:
IF NOT initialized (this packet)
THEN ds := nilspace;
macro table := ds;
macros leeren
FI.
macros leeren:
anz macro zeilen := 0;
anz macros := 0.
END PROC init macros;
PROC load macros (TEXT CONST fname):
init macros;
line;
IF exists (fname)
THEN f := sequential file (input, fname);
forget (ds);
ds := nilspace;
macro table := ds;
macros einlesen
ELSE errorstop ("Datei existiert nicht")
FI.
macros einlesen:
macro end gewesen := TRUE;
anz macros := 0;
anz macro zeilen := 0;
WHILE NOT eof (f) REP
anz macro zeilen INCR 1;
IF anz macro zeilen > max macro zeilen
THEN errorstop ("Zu viele Zeilen (max.1000)")
FI;
cout (anz macro zeilen);
getline (f, zeile);
IF zeile = ""
THEN zeile := " "
ELIF pos (zeile, "#*") > 0
THEN macro name oder end vermerken
FI;
IF macro end gewesen AND zeile = " "
THEN anz macro zeilen DECR 1
ELSE macro table . macro zeilen [anz macro zeilen] := zeile
FI
END REP;
anz macro zeilen INCR 1;
macro table . macro zeilen [anz macro zeilen] := " ";
IF anz macros = 0
THEN putline ("Macros geleert")
FI.
macro name oder end vermerken:
INT CONST komm anfang :: pos (zeile, "#*") + 2,
komm ende :: pos (zeile, "#", komm anfang);
IF komm anfang <> 3 OR hinter dem kommando steht noch was
THEN errorstop ("Macro-Anweisung steht nicht alleine auf der Zeile");
FI;
kommando := subtext (zeile, komm anfang, komm ende -1);
scan (kommando);
next symbol (symbol, type);
IF type = tag
THEN macro namen aufnehmen
ELSE errorstop ("kein Macroname nach #*")
FI;
next symbol (symbol, type);
IF type >= end of scan
THEN macro table . anz parameter [anz macros] := 0;
LEAVE macro name oder end vermerken
ELIF symbol = "("
THEN parameter aufsammeln;
ELSE errorstop ("keine ( nach Macro-Name")
FI.
macro namen aufnehmen:
IF symbol = "macroend"
THEN put ("mit"); put (macro table . anz parameter [anz macros]);
put ("Parameter(n) geladen");
macro end gewesen := TRUE;
line;
LEAVE macro name oder end vermerken
ELIF NOT macro end gewesen
THEN errorstop ("macro end fehlt")
ELSE macro end gewesen := FALSE;
anz macros INCR 1;
IF anz macros > max macros
THEN errorstop ("Zu viele Macros (max. 200")
FI;
macro table . macro namen [anz macros] := symbol;
macro table . macro start [anz macros] := anz macro zeilen;
line;
put (symbol);
FI.
hinter dem kommando steht noch was:
NOT (komm ende = length (zeile) COR
(komm ende + 1 = length (zeile) AND (zeile SUB komm ende + 1) = " ")).
parameter aufsammeln:
INT VAR parameter number :: 1;
next symbol (symbol, type);
WHILE symbol = "$" REP
next symbol (symbol, type);
IF type = number CAND int (symbol) = parameter number
THEN IF parameter number > 9
THEN errorstop ("Anzahl Parameter > 9")
FI;
macro table . anz parameter [anz macros] := parameter number;
parameter number INCR 1;
ELSE errorstop ("Parameter-Nummer inkorrekt: " + symbol)
FI;
next symbol (symbol, type);
IF symbol = ")"
THEN LEAVE parameter aufsammeln
ELIF symbol = ","
THEN next symbol (symbol, type)
ELSE errorstop (", oder ) erwartet:" + symbol)
FI
END REP;
errorstop ("Parameterliste inkorrekt bei" + symbol).
END PROC load macros;
PROC load macros:
load macros (last param)
END PROC load macros;
PROC list macros:
init macros;
note ("");
INT VAR i := 1;
WHILE i <= anz macro zeilen REP
cout (i);
note (macro table . macro zeilen [i]);
note line;
i INCR 1
END REP;
note edit
END PROC list macros;
BOOL PROC macro exists (TEXT CONST name, INT VAR anz params):
INT VAR i;
FOR i FROM 1 UPTO anz macros REP
IF macro table . macro namen [i] = name
THEN anz params := macro table . anz parameter [i];
index aktuelle macro zeile := macro table . macro start [i] + 1;
berechne anzahl zeilen in macro;
IF anz params = 0
THEN with parameters := FALSE
ELSE with parameters := TRUE;
lade macro in replacement store;
index aktuelle macro zeile := 1;
FI;
LEAVE macro exists WITH TRUE
FI
END REP;
FALSE.
berechne anzahl zeilen in macro:
IF i = anz macros
THEN anz zeilen in macro :=
anz macro zeilen - index aktuelle macro zeile;
ELSE anz zeilen in macro :=
macro table . macro start [i + 1] - index aktuelle macro zeile
FI.
lade macro in replacement store:
INT VAR k;
FOR k FROM 1 UPTO anz zeilen in macro REP
macro table . replacement store [k] :=
macro table . macro zeilen [index aktuelle macro zeile +k-1]
END REP.
END PROC macro exists;
PROC replace macro parameter (INT CONST number, TEXT CONST param):
TEXT VAR param text := "$" + text (number);
INT VAR k;
FOR k FROM 1 UPTO anz zeilen in macro - 1 REP
change all (macro table . replacement store [k], param text, param);
END REP
END PROC replace macro parameter;
BOOL PROC macro command and then process parameters (TEXT VAR komm):
init macros;
LET tag = 1;
scan (komm);
next symbol (symbol, type);
IF type = tag
THEN untersuche ob deklariertes macro
ELSE FALSE
FI.
untersuche ob deklariertes macro:
INT VAR anz macro params;
IF macro exists (symbol, anz macro params)
THEN fehlertext := "in Makro: "; fehlertext CAT symbol;
IF anz macro params > 0
THEN macro parameter ersetzen
FI;
TRUE
ELSE FALSE
FI.
macro parameter ersetzen:
next symbol (symbol, type);
IF symbol = "("
THEN ersetze
ELSE report text processing error (34, 0, dummy, symbol + fehlertext);
LEAVE macro command and then process parameters WITH FALSE
FI.
ersetze:
LET text type = 4,
end of scan = 7;
INT VAR number parameter :: 1;
REP
next symbol (symbol, type);
IF type = texttype
THEN replace macro parameter (number parameter, symbol);
ELSE report text processing error (35, 0, dummy, fehlertext + symbol);
LEAVE macro command and then process parameters WITH FALSE
FI;
number parameter INCR 1;
IF number parameter > anz macro params
THEN LEAVE macro command and then process parameters WITH TRUE
FI;
next symbol (symbol, type);
IF symbol <> "," OR type >= end of scan
THEN report text processing error (36, 0, dummy, fehlertext + symbol);
LEAVE macro command and then process parameters WITH FALSE
FI
END REP.
END PROC macro command and then process parameters;
PROC get macro line (TEXT VAR macro zeile):
IF index aktuelle macro zeile > anz zeilen in macro
THEN macro zeile := "#### "
ELIF with parameters
THEN macro zeile :=
macro table . replacement store [index aktuelle macro zeile]
ELSE macro zeile :=
macro table . macro zeilen [index aktuelle macro zeile]
FI;
index aktuelle macro zeile INCR 1;
END PROC get macro line;
INT PROC number macro lines:
anz zeilen in macro
END PROC number macro lines;
END PACKET macro store;
|
