From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 11 Feb 2019 11:49:19 +0100 Subject: Add source files from Michael --- system/dos/1986/src/manager-M.dos.hd | 198 +++++++++++++++++++++++++++++++++++ 1 file changed, 198 insertions(+) create mode 100644 system/dos/1986/src/manager-M.dos.hd (limited to 'system/dos/1986/src/manager-M.dos.hd') diff --git a/system/dos/1986/src/manager-M.dos.hd b/system/dos/1986/src/manager-M.dos.hd new file mode 100644 index 0000000..5eb97c7 --- /dev/null +++ b/system/dos/1986/src/manager-M.dos.hd @@ -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 fr 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; -- cgit v1.2.3