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
|
(* ------------------- VERSION 2 05.05.86 ------------------- *)
PACKET command handler DEFINES (* Autor: J.Liedtke *)
get command ,
analyze command ,
do command ,
command error ,
cover tracks :
LET cr lf = ""4""13""10"" ,
esc k = ""27"k" ,
command pre = ""4""13" " ,
command post = ""13""10" " ,
max command length = 2010 ,
tag type = 1 ,
texttype = 4 ,
eof type = 7 ;
TEXT VAR command handlers own command line := "" ,
previous command line := "" ,
symbol ,
procedure ,
pattern ,
error note := "" ;
INT VAR symbol type ;
PROC get command (TEXT CONST command text) :
get command (command text, command handlers own command line)
ENDPROC get command ;
PROC get command (TEXT CONST command text, TEXT VAR command line) :
set line nr (0) ;
error protocoll ;
get command from console .
error protocoll :
IF is error
THEN put error ;
clear error
ELSE command line := "" ;
FI .
get command from console :
normalize cursor ;
REP
out (command pre) ;
out (command text) ;
out (command post) ;
editget command
UNTIL command line <> "" PER ;
param position (LENGTH command line) ;
out (command post) .
editget command :
TEXT VAR exit char ;
REP
get cursor (x, y) ;
editget (command line, max command length, x size - x,
"", "k", exit char) ;
ignore halt errors during editget ;
break quiet if command line is too long ;
IF exit char = esc k
THEN cursor to begin of command input ;
command line := previous command line
ELIF LENGTH command line > 1
THEN previous command line := command line ;
LEAVE editget command
ELSE LEAVE editget command
FI
PER .
normalize cursor :
INT VAR x, y;
out (crlf) ;
get cursor (x, y) ;
cursor (x, y) .
ignore halt errors during editget :
IF is error
THEN clear error
FI .
break quiet if command line is too long :
IF command line is too long
THEN command line := "break (quiet)"
FI .
command line is too long :
LENGTH command line = max command length .
cursor to begin of command input :
out (command pre) .
ENDPROC get command ;
PROC analyze command ( TEXT CONST command list,
INT CONST permitted type,
INT VAR command index, number of params,
TEXT VAR param 1, param 2) :
analyze command (command list, command handlers own command line,
permitted type, command index,
number of params, param 1, param 2)
ENDPROC analyze command ;
PROC analyze command ( TEXT CONST command list, command line,
INT CONST permitted type,
INT VAR command index, number of params,
TEXT VAR param 1, param 2) :
error note := "" ;
scan (command line) ;
next symbol ;
IF symbol type <> tag type AND symbol <> "?"
THEN error ("Name ungueltig") ;
impossible command
ELIF pos (command list, symbol) > 0
THEN procedure name ;
parameter list pack option ;
nothing else in command line ;
decode command
ELSE impossible command
FI .
procedure name :
procedure := symbol ;
next symbol .
parameter list pack option :
number of params := 0 ;
param 1 := "" ;
param 2 := "" ;
IF symbol = "("
THEN next symbol ;
parameter list ;
IF symbol <> ")" AND error note = ""
THEN error (") fehlt")
FI
ELIF symbol type <> eof type
THEN error ("( fehlt")
FI .
parameter list :
parameter (param 1, number of params, permitted type) ;
IF symbol = ","
THEN next symbol ;
parameter (param 2, number of params, permitted type) ;
FI .
nothing else in command line :
next symbol ;
IF symbol <> ""
THEN error ("Kommando zu schwierig")
FI .
decode command :
command index := index (command list, procedure, number of params) .
impossible command :
command index := 0 .
ENDPROC analyze command ;
PROC parameter (TEXT VAR param, INT VAR number of params,
INT CONST permitted type) :
IF symbol type = text type OR symbol type = permitted type
THEN param := symbol ;
number of params INCR 1 ;
next symbol
ELSE error ("Parameter ist kein TEXT ("" fehlt)")
FI
ENDPROC parameter ;
INT PROC index (TEXT CONST list, procedure, INT CONST params) :
pattern := procedure ;
pattern CAT ":" ;
IF procedure name found
THEN get colon pos ;
get dot pos ;
get end pos ;
get command index ;
get param index ;
IF param index >= 0
THEN command index + param index
ELSE - command index
FI
ELSE 0
FI .
procedure name found :
INT VAR index pos := pos (list, pattern) ;
WHILE index pos > 0 REP
IF index pos = 1 COR (list SUB index pos - 1) <= "9"
THEN LEAVE procedure name found WITH TRUE
FI ;
index pos := pos (list, pattern, index pos + 1)
PER ;
FALSE .
get param index :
INT CONST param index :=
pos (list, text (params), dot pos, end pos) - dot pos - 1 .
get command index :
INT CONST command index :=
int ( subtext (list, colon pos + 1, dot pos - 1) ) .
get colon pos :
INT CONST colon pos := pos (list, ":", index pos) .
get dot pos :
INT CONST dot pos := pos (list, ".", index pos) .
get end pos :
INT CONST end pos := dot pos + 4 .
ENDPROC index ;
PROC do command :
do (command handlers own command line)
ENDPROC do command ;
PROC error (TEXT CONST message) :
error note := message ;
scan ("") ;
procedure := "-"
ENDPROC error ;
PROC command error :
disable stop ;
IF error note <> ""
THEN errorstop (error note) ;
error note := ""
FI ;
enable stop
ENDPROC command error ;
PROC next symbol :
next symbol (symbol, symbol type)
ENDPROC next symbol ;
PROC cover tracks :
cover tracks (command handlers own command line) ;
cover tracks (previous command line) ;
erase buffers of compiler and do packet .
erase buffers of compiler and do packet :
do (command handlers own command line) .
ENDPROC cover tracks ;
PROC cover tracks (TEXT VAR secret) :
INT VAR i ;
FOR i FROM 1 UPTO LENGTH secret REP
replace (secret, i, " ")
PER ;
WHILE LENGTH secret < 13 REP
secret CAT " "
PER
ENDPROC cover tracks ;
ENDPACKET command handler ;
|
