1 files changed, 198 insertions, 0 deletions
diff --git a/system/dos/1986/src/manager-M.dos.fd b/system/dos/1986/src/manager-M.dos.fd
new file mode 100644
index 0000000..601d521
--- /dev/null
+++ b/system/dos/1986/src/manager-M.dos.fd
@@ -0,0 +1,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〉 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;