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;