summaryrefslogtreecommitdiff
path: root/system/dos/1.8.7/src/manager-M.dos
blob: e27c513922b101bb0e39353a995d532a5c816582 (plain)
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
PACKET dos manager multi DEFINES             (* Copyright (C) 1985, 86, 87 *)
                                             (* Frank Klapper              *)
  provide channel,                           (* 16.10.87                   *)
  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,
    format code      = 23,

    log code         = 78,

    quote            = """";

BOUND STRUCT (TEXT name, pass) VAR msg;

TASK VAR order task;

INT VAR dos channel;

INT VAR fetch save modus;

REAL VAR last access time := 0.0;

TASK VAR disk owner := niltask; 

TEXT VAR save file name;

PROC provide channel (INT CONST channel):
  dos channel := channel

END PROC provide channel;

IF hd version
  THEN provide channel (29)
  ELSE provide channel (std archive channel)
FI;

PROC dos manager:
  dos manager (dos channel)

END PROC dos manager;

PROC dos manager (INT CONST channel):
  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;
  IF order task = disk owner
    THEN last access time := clock (1)
  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
    CASE format code    : format
    CASE log code       : send log
    OTHERWISE errorstop ("unbekannter Auftrag für Task: " + name (myself))
  END SELECT.

fetch file:
  fetch (dos name (msg.name, read modus), ds, fetch save modus);
  manager ok (ds).

check:
  check file (dos name (msg.name, read modus));
  manager message (expanded name (msg.name, read modus) + " ohne Fehler gelesen"). 

format:
  IF phase = 1
    THEN manager question ("Diskette formatieren")
    ELSE format dos disk (int (msg.name));
         manager ok (ds)
  FI.

save file:
  IF phase = 1
    THEN save first phase
    ELSE save second phase
  FI.

save first phase:
  save file name := dos name (msg.name, write modus);
  IF dos file exists (save file name)
    THEN manager question (expanded name (msg.name, write modus) + " auf der MS-DOS Disk ueberschreiben")
    ELSE send (order task, second phase ack, ds)
  FI.

save second phase:
  IF dos file exists (save file name)
    THEN erase dos file (save file name)
  FI;
  save (save file name, ds, fetch save modus);
  forget (ds) ;
  ds := nilspace ;
  manager ok (ds).

clear disk: 
  IF phase = 1
    THEN manager question ("Diskette loeschen")
    ELSE clear dos disk;
         manager ok (ds)
  FI.

erase file:
  IF dos file exists (dos name (msg.name, read modus))
    THEN IF phase = 1
           THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen")
           ELSE erase dos file (dos name (msg.name, read modus));
                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 dos file exists (dos name (msg.name, read modus))
    THEN manager ok (ds)
    ELSE send (order task, false code, ds)
  FI.

list disk:
  dos list (ds);
  manager ok (ds).

send log:
  forget (ds);
  ds := old ("logbuch");
  manager ok (ds).

deliver directory:
  forget (ds);
  ds := nilspace;
  BOUND THESAURUS VAR all names := ds;
  all names := all dos files;
  manager ok (ds).

reserve:
  IF reserve or free permitted
    THEN continue channel (dos channel);
         disk owner := from task;
         fetch save modus := save fetch mode (msg.name);
         open dos disk (path (msg.name));
         forget ("logbuch", quiet);
         manager ok (ds)
    ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt")
  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 close dos disk;
         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 + dos name (name, status) + quote, 14)

END PROC expanded name;

END PACKET dos manager multi;