From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- system/dos/1.8.7/src/manager-S.dos | 268 +++++++++++++++++++++++++++++++++++++ 1 file changed, 268 insertions(+) create mode 100644 system/dos/1.8.7/src/manager-S.dos (limited to 'system/dos/1.8.7/src/manager-S.dos') diff --git a/system/dos/1.8.7/src/manager-S.dos b/system/dos/1.8.7/src/manager-S.dos new file mode 100644 index 0000000..23885e6 --- /dev/null +++ b/system/dos/1.8.7/src/manager-S.dos @@ -0,0 +1,268 @@ +PACKET dos single DEFINES (* Copyright (C) 1985 *) + (* Frank Klapper *) + (* 11.09.87 *) + /, + dos, + provide dos channel, + archive, + reserve, + release, + save, + fetch, + erase, + check, + exists, + ALL, + SOME, + clear, + list, + format: + +LET std archive channel = 31, + main channel = 1; + +INT VAR dos channel := std archive channel; +INT VAR fetch save modus; + +TYPE DOSTASK = TEXT; + +DOSTASK CONST dos := "DOS"; + +OP := (DOSTASK VAR d, TEXT CONST t): + CONCR (d) := t + +END OP :=; + +DOSTASK OP / (TEXT CONST text): + DOSTASK VAR d; + CONCR (d) := text; + d + +END OP /; + +BOOL PROC is dostask (DOSTASK CONST d): + CONCR (d) = "DOS" + +END PROC is dos task; + +PROC provide dos channel (INT CONST channel no): + dos channel := channel no + +END PROC provide dos channel; + +DATASPACE VAR space := nilspace; +forget (space); + +PROC reserve (TEXT CONST string, DOSTASK CONST task): + IF is dostask (task) + THEN fetch save modus := save fetch mode (string); + open dos disk (path (string)) + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +END PROC reserve; + +PROC archive (TEXT CONST string, DOSTASK CONST task): + reserve (string, task) + +END PROC archive; + +PROC release (DOSTASK CONST task): + IF is dos task (task) + THEN close dos disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +END PROC release; + +PROC fetch (TEXT CONST name, DOSTASK CONST from): + IF is dostask (from) + THEN fetch from dos disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +fetch from dos disk: + IF NOT exists (name) COR overwrite permitted + THEN do fetch + FI. + +overwrite permitted: + say ("eigene Datei """) ; + say (name) ; + yes (""" auf der Diskette ueberschreiben"). + +do fetch: + last param (name); + disable stop; + continue (dos channel); + fetch (dos name (name, read modus), space, fetch save modus); + continue (main channel); + IF NOT is error + THEN forget (name, quiet); + copy (space, name) + FI; + forget (space). + +END PROC fetch; + +PROC erase (TEXT CONST name, DOSTASK CONST task): + IF is dos task (task) + THEN do erase dos file + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +do erase dos file: + IF NOT exists (name, /"DOS") + THEN error stop ("die Datei """ + name + """ gibt es nicht") + ELIF yes ("""" + dos name (name, read modus)+ """ auf Der Diskette loeschen") + THEN disable stop; + continue (dos channel); + erase dos file (dos name (name, read modus)); + continue (main channel) + FI. + +END PROC erase; + +PROC save (TEXT CONST name, DOSTASK CONST task): + IF is dos task (task) + THEN save to dos disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +save to dos disk: + TEXT CONST save file name :: dos name (name, write modus); + disable stop; + continue (dos channel); + IF NOT dos file exists (save file name) COR overwrite permitted + THEN IF dos file exists (save file name) + THEN erase dos file (save file name) + FI; + save (save file name, old (name), fetch save modus); + FI; + continue (main channel). + +overwrite permitted: + continue (main channel); + BOOL CONST result :: yes ("""" + save file name + """ auf der Diskette ueberschreiben"); + continue (dos channel); + result. + +END PROC save; + +PROC check (TEXT CONST name, DOSTASK CONST from): + IF is dostask (from) + THEN disable stop; + continue (dos channel); + check file (dos name (name, read modus)); + continue (main channel) + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +END PROC check; + +BOOL PROC exists (TEXT CONST name, DOSTASK CONST task): + IF is dos task (task) + THEN disable stop; + continue (dos channel); + BOOL VAR dummy := dos file exists (dos name (name, read modus)); + continue (main channel); + enable stop; + dummy + ELSE error stop ("die angesprochene Task existiert nicht"); FALSE + FI. + +END PROC exists; + +PROC list (DOSTASK CONST from): + forget (space); + space := nilspace; + FILE VAR list file := sequential file (output, space); + list (list file, from); + modify (list file); + show (list file); + forget (space). + +ENDPROC list; + +PROC list (FILE VAR list file, DOSTASK CONST from): + IF is dos task (from) + THEN list dos disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +list dos disk: + disable stop; + continue (dos channel); + dos list (space); + continue (main channel); + enable stop; + output (list file); + FILE VAR list source := sequential file (output, space); + TEXT VAR line; + WHILE NOT eof (list source) REP + getline (list source, line); + putline (list file, line) + PER. + +END PROC list; + +THESAURUS OP ALL (DOSTASK CONST task): + IF is dos task (task) + THEN disable stop; + continue (dos channel); + THESAURUS VAR dummy := all dos files; + continue (main channel); + enable stop; + dummy + ELSE error stop ("die angesprochene Task existiert nicht"); empty thesaurus + FI. + +END OP ALL; + +THESAURUS OP SOME (DOSTASK CONST task): + IF is dos task (task) + THEN disable stop; + continue (dos channel); + THESAURUS VAR dummy := all dos files; + continue (main channel); + enable stop; + SOME dummy + ELSE error stop ("die angesprochene Task existiert nicht"); empty thesaurus + FI. + +END OP SOME; + +PROC clear (DOSTASK CONST task): + IF is dos task (task) + THEN clear disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +clear disk: + disable stop; + IF yes ("Diskette loeschen") + THEN continue (dos channel); + clear dos disk; + continue (main channel) + FI. + +END PROC clear; + +PROC format (INT CONST format code, DOSTASK CONST task): + IF is dos task (task) + THEN format disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +format disk: + disable stop; + IF yes ("Diskette formatieren") + THEN continue (dos channel); + format dos disk (format code); + continue (main channel) + FI. + +END PROC format; + +END PACKET dos single; + -- cgit v1.2.3