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
|
PACKET free channel DEFINES (* Autor: J.Liedtke *)
(* Stand: 05.10.82 *)
FCHANNEL ,
:= ,
free channel ,
open ,
close ,
out ,
in ,
dialogue :
LET ack = 0 ,
nak = 1 ,
break code = 6 ,
empty message code = 256 ,
long message code = 257 ,
file message code = 1024 ,
open code = 1000 ,
close code = 1001 ,
cr = ""13"" ;
INT CONST task not existing := - 1 ;
TYPE FCHANNEL = STRUCT (TASK server, TEXT input buffer, server name) ;
INT VAR message code , response code ;
TASK VAR partner , used by ;
DATASPACE VAR ds ;
BOUND TEXT VAR msg ;
TEXT VAR response, char, esc char , record ;
FILE VAR file ;
OP := (FCHANNEL VAR dest, FCHANNEL CONST source) :
dest.server := source.server ;
dest.input buffer := "" ;
dest.server name := source.server name ;
open (dest)
ENDOP := ;
FCHANNEL PROC free channel (TEXT CONST channel name) :
FCHANNEL:(niltask,"", channel name)
ENDPROC free channel ;
PROC open (FCHANNEL VAR channel) :
TASK VAR task id ;
INT VAR receipt ;
initialize message dataspace ;
send open code ;
IF receipt <> ack
THEN errorstop ("channel not free")
FI .
initialize message dataspace :
forget (ds) ;
ds := nilspace .
send open code :
ping pong (channel.server, open code, ds, receipt) ;
IF receipt = task not existing
THEN channel.server := task (channel.server name) ;
ping pong (channel.server, open code, ds, receipt)
FI .
ENDPROC open ;
PROC close (FCHANNEL VAR channel) :
call (channel.server, close code, ds, response code)
ENDPROC close ;
PROC close (TEXT CONST channel server) :
call (task (channel server), close code, ds, response code)
ENDPROC close ;
PROC out (FCHANNEL VAR channel, TEXT CONST message) :
send message ;
get response .
send message :
IF message = ""
THEN call (channel.server, empty message code, ds, response code)
ELSE msg := ds ;
CONCR (msg) := message ;
call (channel.server, long message code, ds, response code)
FI .
get response :
IF response code < 0
THEN errorstop ("channel not ready")
ELIF response code < 256
THEN channel.input buffer CAT code (response code)
ELIF response code = long message code
THEN msg := ds ;
channel.input buffer CAT CONCR (msg)
FI .
ENDPROC out ;
PROC in (FCHANNEL VAR channel, TEXT VAR response) :
out (channel, "") ;
response := channel.input buffer ;
channel.input buffer := ""
ENDPROC in ;
PROC out (FCHANNEL VAR channel, DATASPACE CONST file space) :
out (channel, file space, ""0"")
ENDPROC out ;
PROC out (FCHANNEL VAR channel, DATASPACE CONST file space,
TEXT CONST handshake char) :
forget (ds) ;
ds := file space ;
call (channel.server, file message code + code (handshake char) ,
ds, response code) ;
forget (ds) ;
ds := nilspace
ENDPROC out ;
PROC dialogue (FCHANNEL CONST channel, TEXT CONST esc) :
forget (ds) ;
ds := nilspace ;
partner := channel.server ;
esc char := esc ;
enable stop ;
response code := empty message code ;
REP
get and send message charety ;
out response option
PER .
get and send message charety :
IF response code = empty message code
THEN char := incharety (10)
ELSE char := incharety
FI ;
IF char = ""
THEN call (partner, empty message code, ds, response code)
ELIF char = esc char
THEN LEAVE dialogue
ELSE call (partner, code (char), ds, response code)
FI .
out response option :
IF response code < 256
THEN out (code (response code))
ELIF response code = long message code
THEN msg := ds ;
out (CONCR (msg))
FI .
ENDPROC dialogue ;
PROC free channel (INT CONST nr) :
INT CONST my channel := nr ;
break ;
disable stop ;
REP
wait (ds, message code, partner) ;
IF message code = open code
THEN connect to my channel ;
use channel ;
break without advertise ;
send handshake ack
ELSE send (partner, nak, ds)
FI
PER .
use channel :
ping pong (partner, ack, ds, message code) ;
REP
execute message ;
response option
PER .
execute message :
IF message code < 0
THEN LEAVE use channel
ELIF message code < 256
THEN out (code (message code))
ELIF message code = long message code
THEN msg := ds ;
out (CONCR (msg))
ELIF message code >= file message code
THEN send file ;
clear error
ELIF message code = close code
THEN LEAVE use channel
FI .
response option :
response := incharety (1) ;
IF response = ""
THEN ping pong (partner, empty message code, ds, message code)
ELSE short or long response
FI .
short or long response :
char := incharety ;
IF char = ""
THEN short response
ELSE long response
FI .
short response :
ping pong (partner, code (response), ds, message code) .
long response :
msg := ds ;
response CAT char ;
REP
char := incharety ;
response CAT char
UNTIL char = "" PER ;
CONCR (msg) := response ;
ping pong (partner, long message code, ds, message code) .
connect to my channel :
continue (my channel) ;
WHILE is error REP
clear error ;
pause (100) ;
continue (my channel)
PER .
break without advertise :
INT VAR receipt ;
call (supervisor, break code, ds, receipt) .
send handshake ack :
send (partner, ack, ds) .
ENDPROC free channel ;
PROC send file :
enable stop ;
get handshake ;
file := sequential file (input,ds) ;
REP
getline (file, record) ;
out (record) ;
out (cr) ;
handshake option
UNTIL eof (file) PER .
get handshake :
TEXT CONST handshake char := code (message code - file message code) .
handshake option :
IF handshake char <> ""0""
THEN wait for handshake or time out
FI .
wait for handshake or time out :
REP
char := incharety (300)
UNTIL char = handshake char OR char = "" PER ;
IF char = ""
THEN LEAVE send file
FI .
ENDPROC send file ;
ENDPACKET free channel ;
|
