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
|
PACKET dos manager multi DEFINES (* Copyright (C) 1985 *)
(* Frank Klapper *)
provide channel, (* 25.03.86 *)
dos manager:
LET std archive channel = 31,
ack = 0,
second phase ack = 5,
false code = 6,
fetch code = 11,
save code = 12,
exists code = 13,
erase code = 14,
list code = 15,
all code = 17,
clear code = 18,
reserve code = 19,
free code = 20,
check read code = 22,
quote = """";
BOUND STRUCT (TEXT name, pass) VAR msg;
TASK VAR order task;
INT VAR dos channel;
REAL VAR last access time := 0.0;
TASK VAR disk owner := niltask;
PROC provide channel (INT CONST channel):
dos channel := channel
END PROC provide channel;
(*COND FLOPPY
provide channel (std archive channel);
ENDCOND*)
(*COND HDU*)
provide channel (29)
(*ENDCOND*)
PROC dos manager:
dos manager (dos channel)
END PROC dos manager;
PROC dos manager (INT CONST channel):
(*COND FLOPPY
load shard interface table;
ENDCOND*)
dos channel := channel;
task password ("-");
global manager
(PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) dos manager)
END PROC dos manager;
PROC dos manager (DATASPACE VAR ds, INT CONST order code, phase,
TASK CONST from task):
enable stop;
order task := from task;
msg := ds;
IF NOT (order task = disk owner) AND
order code <> free code AND order code <> reserve code
THEN errorstop ("DOS nicht angemeldet")
FI;
SELECT order code OF
CASE fetch code : fetch file
CASE save code : save file
CASE erase code : erase file
CASE clear code : clear disk
CASE exists code : exists file
CASE list code : list disk
CASE all code : deliver directory
CASE reserve code : reserve
CASE free code : free
CASE check read code: check
OTHERWISE errorstop ("unbekannter Auftrag für Task: " + name (myself))
END SELECT.
fetch file:
disk fetch (msg.name, ds);
manager ok (ds).
check:
disk check (msg.name);
manager message (expanded name (msg.name, TRUE) + " ohne Fehler gelesen").
save file:
IF phase = 1
THEN save first phase
ELSE save second phase
FI.
save first phase:
BOOL VAR overwrite question;
disk save first phase (msg.name, overwrite question);
IF overwrite question
THEN manager question (expanded name (msg.name, FALSE) + " auf der MS-DOS Disk ueberschreiben")
ELSE send (order task, second phase ack, ds)
FI.
save second phase:
disable stop;
disk save second phase (ds);
forget (ds) ;
ds := nilspace ;
enable stop;
manager ok (ds).
clear disk:
IF NOT (from task = disk owner)
THEN error stop ("DOS nicht angemeldet")
FI;
IF phase = 1
THEN manager question ("Diskette loeschen")
ELSE disk clear;
manager ok (ds)
FI.
erase file:
IF disk exists (msg.name)
THEN IF phase = 1
THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen")
ELSE disk erase (msg.name);
manager ok (ds)
FI
ELSE manager message ("die Datei " + expanded name (msg.name, TRUE) + " gibt es nicht auf der MS-DOS Disk")
FI.
exists file:
IF disk exists (msg.name)
THEN manager ok (ds)
ELSE send (order task, false code, ds)
FI.
list disk:
disk list (ds);
manager ok (ds).
deliver directory:
forget (ds);
ds := nilspace;
BOUND THESAURUS VAR all names := ds;
all names := disk all;
manager ok (ds).
reserve:
IF reserve or free permitted
THEN do continue channel;
disk owner := from task;
disk reserve (msg.name);
manager ok (ds)
ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt")
FI.
do continue channel:
IF channel <> dos channel
THEN continue channel (dos channel)
FI.
reserve or free permitted :
from task = disk owner OR last access more than five minutes ago
OR disk owner = niltask OR NOT
(exists (disk owner) OR station(disk owner) <> station (myself)).
last access more than five minutes ago :
abs (last access time - clock (1)) > 300.0.
free:
IF reserve or free permitted
THEN disk free;
disk owner := niltask;
break (quiet);
manager ok (ds)
ELSE manager message ("DOS nicht angemeldet")
FI.
END PROC dos manager;
PROC manager ok (DATASPACE VAR ds):
send (order task, ack, ds);
last access time := clock (1).
END PROC manager ok;
TEXT PROC expanded name (TEXT CONST name, BOOL CONST status):
text (quote + adapted name (name, status) + quote, 14)
END PROC expanded name;
END PACKET dos manager multi;
|
