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;