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
|
PACKET port server: (* Autor : R. Ruland *)
(* Stand : 21.03.86 *)
INT VAR port station;
TEXT VAR port := "PRINTER";
put ("gib Name des Zielspools : "); editget (port); line;
put ("gib Stationsnummer des Zielspools : "); get (port station);
server channel (15);
spool duty ("Verwalter fuer Task """ + port +
""" auf Station " + text (port station));
LET max counter = 10 ,
time slice = 300 ,
ack = 0 ,
fetch code = 11 ,
param fetch code = 21 ,
file save code = 22 ,
file type = 1003 ,
begin char = ""0"",
end char = ""1"";
INT VAR reply, old heap size;
TEXT VAR file name, write pass, read pass, sendername, buffer;
FILE VAR file;
DATASPACE VAR ds, file ds, send ds;
BOUND STRUCT (TEXT file name, write pass, read pass, sendername, INT station) VAR msg;
BOUND TEXT VAR error msg ;
spool manager (PROC save file);
PROC save file :
disable stop ;
command dialogue (FALSE);
ds := nilspace; file ds := nilspace; send ds := nil space;
old heap size := heap size;
REP
execute save file;
IF is error THEN save error (error message) FI;
IF heap size > old heap size + 4
THEN collect heap garbage ;
old heap size := heap size
FI;
PER
ENDPROC save file;
PROC execute save file :
enable stop;
forget (file ds) ; file ds := nilspace;
call (father, fetch code, file ds, reply);
IF reply <> ack
THEN error msg := ds; errorstop (error msg);
ELSE save file ds
FI;
. save file ds :
IF type (file ds) = file type
THEN get file params;
insert file params;
call station (port station, port, file save code, file ds);
ELSE errorstop ("Datenraum hat falschen Typ")
FI;
. get file params :
forget (ds); ds := nilspace;
call (father, param fetch code, ds, reply);
IF reply <> ack
THEN error msg := ds; errorstop (error msg);
ELSE msg := ds;
file name := msg. file name;
write pass := msg. write pass;
read pass := msg. read pass;
sendername := msg. sender name;
FI;
. insert file params :
buffer := "";
in headline (filename);
in headline (write pass);
in headline (read pass);
in headline (sendername);
file := sequential file (input, file ds) ;
headline (file, buffer);
END PROC execute save file;
PROC call station (INT CONST order task station, TEXT CONST order task name,
INT CONST order code, DATASPACE VAR order ds) :
INT VAR counter := 0;
TASK VAR order task;
disable stop;
REP order task := order task station // order task name;
IF is error CAND pos (error message, "antwortet nicht") > 0
THEN clear error;
counter := min (max counter, counter + 1);
pause (counter * time slice);
ELSE enable stop;
forget (send ds); send ds := order ds;
call (order task, order code, send ds, reply);
disable stop;
IF reply = ack
THEN forget (order ds); order ds := send ds;
forget (send ds);
LEAVE call station
ELSE error msg := send ds;
errorstop (error msg);
FI;
FI;
PER;
END PROC call station;
TASK OP // (INT CONST station, TEXT CONST name) :
enable stop;
station / name
END OP //;
PROC in headline (TEXT CONST information) :
IF pos (information, begin char) <> 0
OR pos (information, end char) <> 0
THEN errorstop ("Name darf nicht Code 0 oder Code 1 enthalten") FI;
buffer CAT begin char;
buffer CAT information;
buffer CAT end char;
END PROC in headline;
PROC save error (TEXT CONST message) :
clear error;
file name CAT ".";
file name CAT sender name;
file name CAT ".ERROR";
file := sequential file (output, file name);
putline (file, " ");
putline (file, "Uebertragung nicht korrekt beendet ");
putline (file, " ");
put (file, "ERROR :"); put (file, message);
save (file name, public);
clear error;
forget(file name, quiet);
END PROC save error;
ENDPACKET port server;
|
