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/setup/3.1/src/setup eumel 7: setupeumel | 1238 ++++++++++++++++++++++++ 1 file changed, 1238 insertions(+) create mode 100644 system/setup/3.1/src/setup eumel 7: setupeumel (limited to 'system/setup/3.1/src/setup eumel 7: setupeumel') diff --git a/system/setup/3.1/src/setup eumel 7: setupeumel b/system/setup/3.1/src/setup eumel 7: setupeumel new file mode 100644 index 0000000..0504e97 --- /dev/null +++ b/system/setup/3.1/src/setup eumel 7: setupeumel @@ -0,0 +1,1238 @@ +(*************************************************************************) +(*** Hauptprogramm des setup-Eumel:Einstellen der EUMEL - Partitionen ***) +(*** und SHard-Installation auf einer Festplatte. ***) +(*** ***) +(*** Autor : W. Sauerwein Stand : 07.04.89 ***) +(*** I. Ley Version : 2.3 ***) +(*** Anpassung an Modul-SHard : Lutz Prechelt, Karlsruhe ***) +(*** -"- : Werner Metterhausen ***) +(*** -"- : Martin Schönbeck ***) +(*************************************************************************) +(*** V 3.1 14.04.89 shard wird immer mit 'max sh size' geschriegen ***) +(*** da mit 'ds pages' ggf teile fehlten, wenn innen ***) +(*** unbenutzte pages (buffer) waren ***) +(*** V 3.0 10.04.89 support fuer mehrere Laufwerke eingebaut ***) +(*** ausgabe der module vor loeschen etc. entfernt ***) + +PACKET setup eumel DEFINES setup eumel, setup eumel endlos, version, +show partition table: + +LET setup version = "Version 3.1"; + +TEXT VAR stand :: "Stand : 18.04.89 (mit Modul-SHard Version 4.9)"; + +PROC version (TEXT CONST vers): stand := vers END PROC version; + +PROC version: editget (stand) END PROC version; + +LET max partitions = 4, + max sh size = 128, (* Anzahl Bloecke *) + return = ""13"", + escape = ""27""; + +LET hauptmodul namentyp = "SHard *", + modul namentyp = "SHardmodul *", + sh name = "SHARD", + sh backup = "SHARD Sicherungskopie"; + +ROW max partitions INT VAR part list; +ROW max partitions INT VAR part type, part active, + part first track, part last track; +ROW max partitions REAL VAR part start, + part size; + + INT VAR zylinder, + startzeile tabelle :: 1, + startzeile menu :: 12, + active partition, + partitions, + partition, i, j, cx, cy, help; + TEXT VAR retchar, + meldung := ""; + BOOL VAR testausgabe, + mit schreibzugriff := TRUE, + meldung eingetroffen := FALSE, + endlos :: FALSE, + at version; +THESAURUS VAR minimum modulkollektion := empty thesaurus; +DATASPACE VAR ds := nilspace; + +(************************* setup eumel endlos *****************************) + +PROC setup eumel endlos (BOOL CONST b) : + endlos := b; + IF endlos + THEN line; + putline ("Bitte geben Sie nun alle die Dateien an, die der Benutzer auf"); + putline ("keinen Fall löschen darf. (Taste drücken)"); + minimum modulkollektion := certain (all, emptythesaurus); + line (3); + putline ("Der setup eumel kann nun nach dem nächsten Aufruf nicht mehr "); + putline ("verlassen werden. ") + FI. +END PROC setup eumel endlos; + +(******************** get/put actual partition data ************************) + +PROC get actual partition data : + get boot block; + zylinder := tracks; + FOR i FROM 1 UPTO max partitions REP + part type (i) := partition type (i); + part first track (i) := first track (i); + part last track (i) := last track (i); + part start (i) := partition start (i); + part size (i) := partition size (i); + part active (i) := partition word 0 (i); + IF partition active (i) THEN active partition := i FI + PER; + get number of installed partitions; + generate part list. + +get number of installed partitions : + partitions := 0; + FOR i FROM 1 UPTO max partitions REP + IF part type (i) <> 0 THEN partitions INCR 1 FI + PER. + +generate part list : + FOR i FROM 1 UPTO max partitions REP + IF part type (i) <> 0 THEN part list (i) := i + ELSE part list (i) := 0 + FI; + PER; + schiebe nullen nach hinten; + sort part list. + +schiebe nullen nach hinten : + i := 1; INT VAR k := 0; + REP k INCR 1; + IF part list (i) = 0 THEN circle + ELSE i INCR 1 + FI + UNTIL k = max partitions - 1 PER. + +circle : + FOR j FROM i UPTO max partitions - 1 REP + part list (j) := part list (j + 1) + PER; + part list (max partitions) := 0. + +sort part list : + FOR i FROM 2 UPTO partitions REP + FOR j FROM 1 UPTO i - 1 REP + IF part first track (part list (i)) < part first track (part list (j)) + THEN tausche FI + PER + PER. + +tausche : + help := part list (i); + part list (i) := part list (j); + part list (j) := help. + +END PROC get actual partition data; + +PROC put actual partition data : + FOR i FROM 1 UPTO max partitions REP + IF partition exists (i) THEN put partition + ELSE clear partition (i) + FI; + PER; + IF mit schreibzugriff THEN put boot block FI. + +put partition : + IF is eumel (i) THEN partition type (i, part type (i)); + first track (i, part first track (i)); + last track (i, part last track (i)); + partition start (i, part start (i)); + partition size (i, part size (i)) + FI; + partition word 0 (i, part active (i)); + IF active partition = i + THEN partition active (i, TRUE) + ELSE partition active (i, FALSE) + FI. + +END PROC put actual partition data; + +(*************************** setup eumel ********************************) + +PROC setup eumel : + line; command dialogue (TRUE); + at version := yes ("System für AT", TRUE); + testausgabe := FALSE; (*yes ("Testversion", FALSE); *) + pruefe ob notwendige dateien vorhanden; + init modules list; + IF yes ("Leere Floppy für Systemsicherung eingelegt", FALSE) + THEN command dialogue (FALSE); save system; command dialogue (TRUE) FI; + IF NOT endlos THEN putline ("Verlassen mit ESC."); pause (40) FI; + terminal setup; + logo; + generate eumel. + +pruefe ob notwendige dateien vorhanden: + BOUND INT VAR y; + IF mit schreibzugriff THEN y := old (sh name); + y := old ("shget.exe"); + y := old ("bootblock"); + y := old ("configuration"); + y := old ("AT-4.x") + FI. + +END PROC setup eumel; + +PROC generate eumel : + disable stop; + show partition table; + REP update table; + main menu; + action; + IF is error THEN fehler; + put line (error message); + put line ("Bitte betätigen Sie eine Taste !"); + clear error; + pause; + IF mit schreibzugriff THEN terminal setup FI + FI + PER. + +action : + INT VAR choice; + clear error; + REP + cursor (cx, cy); + IF partitions < max partitions + THEN choice := get choice (0, max, retchar) + ELSE choice := get choice (2, max, 0, retchar) + FI; + IF escaped CAND NOT endlos THEN LEAVE generate eumel FI; + UNTIL retchar = return PER; + cl eop (1, startzeile menu - 1); + INT VAR unser kanal := channel; + SELECT choice OF + CASE 0 : programm ende + CASE 1 : create partition (TRUE) + CASE 2 : create partition (FALSE) + CASE 3 : activate partition + CASE 4 : delete partition + CASE 5 : delete partition table + CASE 6 : konfiguration anzeigen + CASE 7 : shard zusammenbauen + CASE 8 : modulkollektion aendern + CASE 9 : change drive + + END SELECT; + continue (unser kanal). + +max : + 9. + +change drive: + cursor (1, startzeile menu); + put ("Bitte Laufwerksnummer angeben:"); + get cursor (cx, cy); + put (" 0 - 3"); + REP cursor (cx, cy); + INT VAR drive := get choice (0, 3, retchar); + IF sure escaped THEN LEAVE change drive FI; + UNTIL NOT escaped PER; + setup channel (28-drive); + show partition table. + + +programm ende : + cursor (1, startzeile menu); + IF keine partition aktiv + THEN IF trotz warnung beenden THEN eumel beenden FI + ELSE IF yes ("Wollen Sie die Partitionierung Ihrer Festplatte beenden", FALSE) + THEN eumel beenden + FI FI. + +keine partition aktiv : active partition = 0. + +trotz warnung beenden : + put line ("ACHTUNG : Es ist keine Partition aktiv gesetzt !"); + put line (" Sie können daher nicht von der Festplatte booten !"); + line; + yes ("Wollen Sie trotzdem die Partitionierung der Festplatte beenden", FALSE). + +eumel beenden : + cl eop (1, startzeile menu - 1); + cursor (1, startzeile menu + 3); + shutup; terminal setup; + logo; + show partition table. + +shard zusammenbauen : + cl eop (1, startzeile menu); + IF yes ("Wollen Sie Ihren SHard neu konfigurieren", FALSE) + THEN shard sichern und vorlage beschaffen; + + IF NOT is error THEN build shard (ds) FI; + IF is error OR NOT exists (sh name) + + THEN forget (sh name, quiet); rename (sh backup, sh name); + putline ("Zusammenbau fehlgeschlagen. Alter SHard erhalten."); + pause (300); + FI; + forget (sh backup, quiet); forget (ds); + show partition table + FI. + +shard sichern und vorlage beschaffen : + forget (sh backup, quiet); + IF exists (shname) + THEN copy (sh name, sh backup); + FI; + forget (ds); + line; + IF yes (""3"Ist in einer existierenden Eumel-Partition ein SHard installiert, +"13""10"der als Vorlage dienen soll", FALSE) + THEN INT VAR vorlage :: 69; + editget (1, startzeile menu + 4, "Partitiontyp: ", vorlage); + (* Das sollte man mal noch schöner machen !!! *) + read file (ds, start of partition (vorlage) + 1.0, max sh size, + setup channel) + ELSE ds := old (sh name) FI. + + +konfiguration anzeigen : + hole anzuzeigenden ds; + line; + print configuration (ds, NOT yes ("Auf dem Drucker ausgeben", FALSE)); + show partition table. + +hole anzuzeigenden ds: + forget (ds); + line; + IF yes ("Soll ein SHard aus einer Partition angezeigt werden", TRUE) + THEN INT VAR anzeige :: 69; + editget (1, startzeile menu + 4, "Partitiontyp: ", anzeige); + (* Das sollte man mal noch schöner machen !!! *) + read file (ds, start of partition (anzeige) + 1.0, max sh size, + setup channel) + ELSE ds := old (ONE ((all LIKE hauptmodul namentyp) + "SHARD")) FI. + + +modulkollektion aendern : + THESAURUS VAR th; + TEXT VAR x :: "SHard"; + INT VAR i ; + page; + th := (all LIKE hauptmodul namentyp) + (all LIKE modul namentyp) + + (all LIKE sh name) ; + (* Diese Ausgabe macht leider den Bildschirmaufbau kaputt *) + (* mit dem Erfolg, daß man dann nicht mehr sieht, was man *) + (* ankreuzt, deshalb auskommentiert *) + (******* + putline(" Alle SHards :"); + line; + FOR i FROM 1 UPTO highest entry(th) + REP + putline(name(th,i)) + PER; + *******) + putline(" Modulkollektion ändern"); + line; + IF yes ("Wollen Sie irgendwelche Module löschen", FALSE) + THEN th := (all LIKE hauptmodul namentyp) + (all LIKE modul namentyp) + + (all LIKE sh name) - minimum modulkollektion; + forget (certain (th, emptythesaurus)); + ELIF yes ("Wollen Sie Module vom Archiv holen", FALSE) + THEN put ("Archivname:"); editget (x); line; + archive (x); + th := ALL archive LIKE modul namentyp; + fetch (certain (th, emptythesaurus), archive); + release (archive) + FI; + init modules list; + show partition table. + + +END PROC generate eumel; + + +PROC show partition table : + IF NOT mit schreibzugriff THEN get actual partition data FI; + headline; + devide table; + columns; + underlines; + rows; + downline. + +head line : + cl eop (1, startzeile tabelle); + put center (startzeile tabelle, "Aktuelle Partitions - Tabelle", TRUE). + +devide table : + FOR i FROM 1 UPTO 8 + REP + cursor (45, startzeile tabelle + i); out (inverse ("")) + PER. + +columns : + cursor ( 1, startzeile tabelle + 2); + out ("Nr. System Typ Zustand Grösse Anfang Ende"); + cursor (48, startzeile tabelle + 2); + out ("Platte : Zyl. / KB"). + +underlines : + cursor ( 1, startzeile tabelle + 3); + out ("--------------------------------------------"); + cursor (47, startzeile tabelle + 3); + out ("------------------------------"). + +rows : + FOR i FROM 1 UPTO max partitions + REP cursor (2, startzeile tabelle + 3 + i); + put (text (i) + " :") + PER. + +downline : + put center (startzeile menu - 3, " EUMEL Installationssystem " + setup version + + " (IBM PC/" + rechner typ + + " und kompatible Rechner) ", TRUE); + put center (startzeile menu - 2, stand, TRUE). + +rechner typ : + IF at version THEN "AT" + ELSE "XT" + FI. + +END PROC show partition table; + +PROC main menu : + biete auswahl an; + IF meldung eingetroffen THEN melde FI; + IF testausgabe THEN ausgabe fuer test FI. + +ausgabe fuer test : + testrahmen; + test out. + +testrahmen : + FOR i FROM startzeile menu - 1 UPTO startzeile menu + 9 + REP + cl eol (45, i); + put (inverse ("")) + PER; + cursor (52, startzeile menu); + put ("Ecke für Test-Output"); + cursor (52, startzeile menu). + +test out : + FOR i FROM 1 UPTO max partitions + REP + cursor (52, startzeile menu + 1 + i); + put (text (i) + ":"); + put (part type (i)); + put (part first track (i)); + put (part last track (i)); + IF active partition = i THEN put ("aktiv") + ELSE put ("inaktiv") + FI; + PER. + +melde : + cursor (1, 24); + put (inverse ("Meldung :")); + put (meldung); + meldung eingetroffen := FALSE. + +biete auswahl an : + cl eop (1, startzeile menu - 1); line; + IF partitions < max partitions + THEN putline (" EUMEL - Partition einrichten .............. 1") + ELSE line; + putline (" EUMEL - Partition") + FI; + cursor (20, startzeile menu + 1); + putline ("erneuern (Neuer SHard) .. 2"); + putline (" aktivieren .............. 3"); + putline (" löschen ................. 4"); + putline (" Partitionstabelle löschen ................. 5"); + putline (" SHard-Konfiguration anzeigen .............. 6"); + putline (" SHard konfigurieren ....................... 7"); + putline (" SHardmodule laden oder löschen ............ 8"); + putline (" Bearbeitetes Laufwerk wechseln ............ 9"); + putline (" SETUP-EUMEL beenden ....................... 0"); + putline ("-----------------------------------------------"); + put (" Ihre Wahl >>"); + get cursor (cx, cy). + +END PROC main menu; + +PROC update table : + IF mit schreibzugriff THEN get actual partition data FI; + FOR i FROM 1 UPTO partitions REP update partition PER; + FOR i FROM partitions + 1 UPTO max partitions REP rubout partition PER; + zeige plattengroesse; + IF active partition = 0 THEN meldung := "ACHTUNG : Es ist keine Partition aktiv gesetzt !"; + meldung eingetroffen := TRUE + FI. + +update partition : + partition := part list (i); + show partition. + +rubout partition : + cursor (5, startzeile tabelle + 3 + i); + out (" "). + +show partition : + cursor (5, startzeile tabelle + 3 + i); + put (name + type + zustand + groesse + startspur + endspur). + +name : subtext (subtext (part name, 1, 7) + + " ", 1, 8). + +type : text (part type (partition), 5) + " ". + +zustand : IF active partition = partition THEN (" aktiv ") + ELSE (" ") + FI. + +startspur : " " + text (part first track (partition), 5). +endspur : text (part last track (partition), 6). +groesse : text (part groesse, 5). + +zeige plattengroesse : + put gesamt; + put noch freie; + put maximaler zwischenraum. + +put maximaler zwischenraum : + cursor (48, startzeile tabelle + 6); + put ("gr. Lücke : " + text (maximaler zwischenraum, 5) + " / " + + kilobyte(maximaler zwischenraum)). + +put gesamt : + cursor (48, startzeile tabelle + 4); + put ("Gesamt : " + text (zylinder, 5) + " / " + + kilobyte(zylinder)). + +put noch freie : + cursor (48, startzeile tabelle + 5); + put ("Frei : " + text (freie zylinder, 5) + " / " + + kilobyte( freie zylinder)). + +END PROC update table; + + +TEXT PROC kilobyte (INT CONST zylinderzahl): + TEXT VAR kb; + kb := text(round(real(zylinderzahl) * real(heads) * real(sectors) * 0.512,0)); + subtext(kb,1,length(kb)-2) + +END PROC kilobyte; + + +PROC create partition (BOOL CONST partition is new) : + IF NOT partition is new + THEN renew partition + ELIF freie part number gefunden CAND noch platz uebrig + THEN new partition + ELSE kein platz mehr FI. + +kein platz mehr : + fehler; + put ("Es kann keine neue Partition mehr eingerichtet werden."); + pause (300). + +noch platz uebrig : freie zylinder > 0. + +freie part number gefunden : + IF partitions < max partitions THEN suche nummer; + TRUE + ELSE FALSE + FI. + +suche nummer : + partition := 0; + REP partition INCR 1 UNTIL part type (partition) = 0 PER. + +new partition : + cl eop (1, startzeile menu); + IF yes ("Neue EUMEL - Partition einrichten", FALSE) + THEN INT VAR alte aktive partition := active partition; + IF NOT partition exists (partition) + THEN IF enter partition spezifikations + THEN IF mit schreibzugriff THEN check part and install FI + FI; + ELSE keine freie partition + FI FI. + +renew partition : + cl eop (1, startzeile menu); + IF yes ("Neuen SHard auf bestehende EUMEL - Partition schreiben", FALSE) + THEN enter part number; + IF mit schreibzugriff THEN check part and install FI + FI. + +enter part number : + put ("Welche Partition wollen Sie erneuern :"); + get cursor (cx, cy); + put (" Abbruch mit "); + REP + REP cursor (cx, cy); + partition := get choice (1, 4, retchar); + IF sure escaped THEN LEAVE create partition FI; + partition := part list (partition) + UNTIL NOT escaped PER; + IF NOT (partition exists (partition) AND is eumel (partition)) + THEN fehler; put ("Keine EUMEL - Partition"); + pause (300); cl eop (1, 20); + FI + UNTIL partition exists (partition) AND is eumel (partition) PER. + +check part and install: + IF partition is new THEN put actual partition data FI; + IF testausgabe THEN put ("Keine Überprüfung schlechter Sektoren, da Testversion !") + ELSE trage schlechte sektoren ein; + FI; + IF is error AND partition is new + THEN active partition := alte aktive partition; + rubout partition; + LEAVE check part and install + ELIF NOT is error + THEN line; + put ("Shard wird auf die Partition geschrieben..."); line (2); + bringe shard auf platte (part type (partition)); + ELSE line; + putline ("Fehler aufgetreten. Partition unverändert") + FI; + put ("Bitte betätigen Sie eine Taste !"); + loesche eingabepuffer; + pause. + +trage schlechte sektoren ein: + INT VAR anzahl schlechter sektoren; + line (2); + putline ("Überprüfen der Partition nach schlechten Sektoren."); + add bad sector table to shard (part type (partition), old (sh name), + NOT partition is new, anzahl schlechter sektoren); + line; + IF NOT is error THEN put ("Ich habe " + bs zahl + " gefunden.") FI. + +bs zahl: + IF anzahl schlechter sektoren = 0 + THEN "keine schlechten Sektoren" + ELIF anzahl schlechter sektoren > 1 + THEN text (anzahl schlechter sektoren) + " schlechte Sektoren" + ELSE "einen schlechten Sektor" + FI. + +keine freie partition : + fehler; + put line ("Sie können nur auf freien Partitionen 'EUMEL' einrichten."); + put ("Die Partition " + text (partition) + " ist bereits mit einem System belegt !"); + pause (300). + +END PROC create partition; + +BOOL PROC enter partition spezifikations : + cl eol (60, startzeile menu); put ("Abbruch mit "); + cl eol (1, startzeile menu + 2); + put ("Typ : EUMEL,"); + INT VAR old end := part last track (partition); + enter part size; + enter part first track; + put end track; + cl eol (60, startzeile menu); + IF NOT eingaben ok THEN LEAVE enter partition spezifikations WITH FALSE FI; + cl eol (1, startzeile menu + 4); + part first track (partition) := int (start); + part last track (partition) := int (start) + int (size) - 1; + part start (partition) := first usable sector; + part size (partition) := first sector behind partition - + part start (partition); + active partition := partition; + part type (partition) := kleinste freie eumel nummer; + add to part list; + TRUE. + +eingaben ok : + cl eop (1, startzeile menu + 4); + yes ("Sind die Partitionsangaben korrekt", FALSE). + +enter part size : + get cursor (cx, cy); + REP + REP cursor (cx, cy); + put ("Welche Grösse :"); + TEXT VAR size := groessenvorschlag; + loesche eingabepuffer; + editget (size, escape, "", retchar); + IF sure escaped + THEN LEAVE enter partition spezifikations WITH FALSE + FI + UNTIL NOT escaped PER; + IF NOT size ok THEN falsche groesse FI + UNTIL size ok AND not too big PER; + cl eol (1, y + 1); + cl eol (1, y + 2); + cl eol (cx, cy); + put ("Grösse : " + size + ";"). + +size ok : + NOT size greater maxint + CAND size positiv + AND desired size <= maximaler zwischenraum. + +not too big: + INT VAR x,y; + get cursor(x,y); + IF real(kilobyte(int(size))) >= 16196.0 + THEN line; + putline("Eine Partition grösser 16 MB ist nur bei einer + Version sinnvoll !"); + yes("Eingabe korrekt",FALSE) + ELSE TRUE + FI. + +size greater maxint : + length (size) >= 5. + +size positiv : + desired size > 0. + +falsche groesse : + fehler; + put line ("Es kann keine Partition mit " + size + " Zylindern eingerichtet werden !"); + IF NOT size greater maxint CAND size positiv + THEN put ("Die grösste zusammenhängende Anzahl Zylinder ist " + + text (maximaler zwischenraum) + ".") + ELSE put ("Bitte eine positive Grösse angeben !") + FI. + +groessenvorschlag : + text (maximaler zwischenraum). + +enter part first track : + get cursor (cx, cy); + REP + REP cursor (cx, cy); + put ("Start - Zylinder der Partition :"); + TEXT VAR start := startvorschlag; + loesche eingabepuffer; + editget (start, escape, "", retchar); + IF sure escaped THEN part last track (partition) := old end; + LEAVE enter partition spezifikations WITH FALSE + FI + UNTIL NOT escaped PER; + IF NOT start ok THEN falscher start FI + UNTIL start ok PER; + cl eol (cx, cy); + put ("Start : " + start + ";"). + +put end track : + put ("Ende : " + text (int (start) + int (size) - 1)). + +start ok : + length (start) < 5 + CAND enough room + AND NOT in existing partition + AND NOT out of volume. + +out of volume : desired start > zylinder OR desired start < 0. + +in existing partition : + IF partitions = 0 THEN FALSE + ELSE i := 0; + REP + i INCR 1 + UNTIL start of part i > desired start + OR last partition + OR error found PER; + IF error found THEN TRUE ELSE FALSE FI + FI. + +error found : + part index <> i AND + (start of part i <= desired start AND end spur i >= desired start). + +part index : + 0. + +desired start : int (start). + +start of part i : part first track (part list (i)). + +last partition : i = partitions. + +enough room : + desired start + desired size <= begin of next partition. + +desired size : int (size). + +begin of next partition : + IF partitions = 0 THEN zylinder + ELSE i := 0; + REP + i INCR 1; + UNTIL start of part i > desired start + OR last partition PER; + IF start of part i > desired start THEN start of part i + ELSE zylinder + FI + FI. + +falscher start : + fehler; + put ("Auf Zylinder " + start); + put ("kann keine Partition der Grösse " + size); + put ("beginnen !"). + +startvorschlag : + text (best start position). + +best start position : + IF partitions = 0 THEN 0 + ELSE best start spur vor und zwischen den partitionen + FI. + +best start spur vor und zwischen den partitionen : + INT VAR best start := 0, min size := zylinder; + FOR i FROM 0 UPTO partitions + REP + IF platz genug zwischen i und i plus 1 AND kleiner min size + THEN min size := platz zwischen i und i plus 1; + best start := start des zwischenraums + FI + PER; + best start. + +start des zwischenraums : + end spur i + 1. + +end spur i : + IF i = 0 THEN -1 + ELSE part last track (part list (i)) + FI. + +platz zwischen i und i plus 1 : + part first track i plus 1 - (end spur i + 1). + +part first track i plus 1 : + IF i = partitions THEN zylinder + ELSE part first track (part list (i + 1)) + FI. + +platz genug zwischen i und i plus 1 : + platz zwischen i und i plus 1 >= int (size). + +kleiner min size : platz zwischen i und i plus 1 < min size. + +first usable sector: + IF int (start) = 0 + THEN 1.0 + ELSE real (heads * sectors) * real (start) + FI. + +first sector behind partition: + real (heads * sectors) * (real(start) + real (size)). + +kleinste freie eumel nummer : + IF partitions = 0 THEN 69 + ELSE search for part type (69) + FI. + +END PROC enter partition spezifikations; + +INT PROC search for part type (INT CONST minimum) : + IF minimum exists THEN search for part type (minimum + 1) + ELSE minimum + FI. + +minimum exists : + BOOL VAR exists := FALSE; + INT VAR i; + FOR i FROM 1 UPTO partitions REP + IF part type (part list (i)) = minimum THEN exists := TRUE FI + PER; + exists. + +END PROC search for part type; + +PROC bringe shard auf platte (INT CONST eumel type): + IF mit schreibzugriff THEN + enable stop; + INT CONST old session :: session; + fixpoint; + IF session <> old session + THEN errorstop ("SHard auf Platte schreiben im RERUN !") FI; + write file ("shget.exe", start der eumel partition, 1, setup channel); + write file (sh name, start der eumel partition + 1.0, + max sh size, setup channel) + FI. + +start der eumel partition: + start of partition (eumel type). +END PROC bringe shard auf platte; + + +PROC add to part list : + IF part list leer THEN part list (1) := partition + ELIF neuer start vor letzter partition THEN fuege ein + ELSE haenge an + FI; + partitions INCR 1. + +part list leer : partitions = 0. + +neuer start vor letzter partition : + part first track (partition) < part first track (part list (partitions)). + +haenge an : part list (partitions + 1) := partition. + +fuege ein : + suche erste partition die spaeter startet; + schiebe restliste auf; + setze partition ein. + +suche erste partition die spaeter startet : + i := 0; + REP i INCR 1 + UNTIL part first track (part list (i)) > part first track (partition) PER. + +schiebe restliste auf : + FOR j FROM partitions DOWNTO i + REP + part list (j + 1) := part list (j) + PER. + +setze partition ein : + part list (i) := partition. + +END PROC add to part list ; + +INT PROC maximaler zwischenraum : + IF partitions = 0 THEN zylinder + ELSE max (maximaler platz vor und zwischen den partitionen, + platz hinter letzter partition) + FI. + +maximaler platz vor und zwischen den partitionen : + help := platz vor erster partition; + FOR i FROM 1 UPTO partitions - 1 + REP + help := max (help, begin of part i plus 1 - end of part i - 1) + PER; + help. + +platz vor erster partition : + part first track (part list (1)). + +platz hinter letzter partition : + zylinder - part last track (part list (partitions)) - 1. + +begin of part i plus 1 : + part first track (part list (i + 1)). + +end of part i : + part last track (part list (i)). + +END PROC maximaler zwischenraum; + +PROC activate partition : + enter part number; + IF NOT escaped THEN set partition active FI. + +set partition active : + IF yes ("Partition mit Typnummer " + text (part type (partition)) + " aktivieren", FALSE) + THEN active partition := partition; + put actual partition data + FI. + +enter part number : + cursor (60, startzeile menu); put ("Abbruch mit "); + cursor ( 1, startzeile menu); + put ("Welche Partition wollen Sie aktivieren :"); + get cursor (cx, cy); + REP + REP cursor (cx, cy); + partition := get choice (1, 4, retchar); + IF sure escaped THEN LEAVE activate partition FI; + partition := part list (partition) + UNTIL NOT escaped PER; + IF NOT partition exists (partition) THEN fehler melden FI + UNTIL partition exists (partition) PER; + cl eol (60, startzeile menu); + cl eop (1, cy + 2). + +fehler melden : + partition gibt es nicht. + +partition gibt es nicht : + fehler; + put ("Diese Partition gibt es nicht."). + +END PROC activate partition; + +PROC delete partition : + enter part number; + IF NOT escaped THEN + IF yes ("Partition mit Typnummer " + text (part type (partition)) + " löschen", FALSE) + AND ganz sicher + THEN rubout partition + FI FI. + +enter part number : + cursor (60, startzeile menu); put ("Abbruch mit "); + cursor ( 1, startzeile menu); + put ("Welche Partition wollen Sie löschen :"); + get cursor (cx, cy); + REP + REP cursor (cx, cy); + partition := get choice (1, 4, retchar); + IF sure escaped THEN LEAVE delete partition FI; + partition := part list (partition) + UNTIL NOT escaped PER; + IF NOT (partition exists (partition) AND is eumel (partition)) THEN fehler melden FI + UNTIL partition gueltig AND is eumel (partition) PER; + cl eol (60, startzeile menu); + cl eop (1, cy + 2). + +fehler melden : + IF NOT partition exists (partition) THEN partition gibt es nicht + ELSE keine eumel partition + FI. + +partition gibt es nicht : + fehler; + put ("Diese Partition gibt es nicht."). + +ganz sicher : + line; + yes ("Sind Sie sich ganz sicher", FALSE). + +END PROC delete partition; + +PROC delete partition table : + cursor ( 1, startzeile menu + 1); + put ("Es gehen ALLE Daten verloren, die sich auf Ihrer Platte befinden !"); + line (2); + IF yes ("Wollen Sie wirklich die ganze Partitionstabelle löschen", FALSE) + THEN line; + IF yes ("Sind Sie sich ganz sicher", FALSE) + THEN loesche ganze tabelle + FI FI. + +loesche ganze tabelle : + FOR i FROM 1 UPTO max partitions + REP part type (i) := 0; + part first track (i) := 0; + part last track (i) := 0; + part start (i) := 0.0; + part size (i) := 0.0; + part list (i) := 0 + PER; + partitions := 0; + active partition := 0; + IF mit schreibzugriff THEN clear partition table (-3475) FI. + +END PROC delete partition table; + +PROC rubout partition : + part type (partition) := 0; + part first track (partition) := 0; + part last track (partition) := 0; + IF active partition = partition THEN active partition := 0 FI; + del from part list; + put actual partition data. + +del from part list : + search for partition in part list; + delete it and set highest to 0; + partitions DECR 1. + +search for partition in part list : + i := 0; + REP i INCR 1 UNTIL part list (i) = partition PER. + +delete it and set highest to 0 : + FOR j FROM i UPTO partitions - 1 + REP + part list (j) := part list (j + 1) + PER; + part list (partitions) := 0. + +END PROC rubout partition; + +INT PROC get choice (INT CONST von, bis, TEXT VAR retchar): + get choice (von, bis, von, retchar) +END PROC get choice; + +INT PROC get choice (INT CONST von, bis, zusatz, TEXT VAR retchar): + LET return = ""13"", + escape = ""27"", + left = ""8""; + TEXT VAR buffer; + INT VAR cx, cy; + get cursor (cx, cy); out (" " + left); + REP + REP + cursor (cx, cy); buffer := incharety; + UNTIL input ok OR buffer = escape PER; + IF buffer = escape THEN retchar := escape; + LEAVE get choice WITH 0 + FI; + out (buffer); + leseschleife bis left or ret; + IF retchar = left THEN out (left + " ") FI; + IF retchar = escape THEN LEAVE get choice WITH 0 FI + UNTIL retchar = return OR retchar = escape PER; + int (buffer). + +input ok : (buffer >= text (von) AND buffer <= text (bis)) OR buffer = text (zusatz). + +leseschleife bis left or ret: + REP + inchar (retchar) + UNTIL retchar = return OR retchar = left OR retchar = escape PER. + +END PROC get choice; + +TEXT PROC inverse (TEXT CONST t): + ""15"" + t + " " + ""14"" +END PROC inverse; + +PROC put center (TEXT CONST t): + put center (t, 80) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, BOOL CONST inverse): + put center (zeile, t, 80, inverse); +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t): + put center (zeile, t, 80) +END PROC put center; + +PROC put center (TEXT CONST t, INT CONST gesamtbreite): + INT VAR cy; + get cursor (cy, cy); + put center (cy, t, gesamtbreite) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite): + put center (zeile, t, gesamtbreite, FALSE); +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite, + BOOL CONST inverse): + IF inverse + THEN cursor (1, zeile); + out (""15""); + gesamtbreite - 2 TIMESOUT " "; + FI; + cursor ((gesamtbreite - length (t)) DIV 2, zeile); + put (t); + IF inverse + THEN cursor (gesamtbreite - 1, zeile); + out (""14""); + FI +END PROC put center; + +PROC cl eol: + out (""5"") +END PROC cl eol; + +PROC cl eop: + out (""4"") +END PROC cl eop; + +PROC cl eol (INT CONST cx, cy): + cursor (cx, cy); + cl eol +END PROC cl eol; + +PROC cl eop (INT CONST cx, cy): + cursor (cx, cy); + cl eop +END PROC cl eop; + +INT PROC partition groesse (INT CONST part) : + part last track (part) - part first track (part) + 1 +END PROC partition groesse; + +BOOL PROC is eumel (INT CONST partition) : + part type (partition) >= 69 AND part type (partition) <= 72 +END PROC is eumel; + +BOOL PROC partition exists (INT CONST partition) : + IF partition > 0 AND partition <= max partitions + THEN part type (partition) <> 0 + ELSE FALSE + FI +END PROC partition exists;. + +part groesse : partition groesse (partition). + +part name : + SELECT part type (partition) OF + CASE 1, 4 : "DOS" + CASE 69, 70, 71, 72 : "EUMEL" + OTHERWISE text (part type (partition)) + END SELECT. + +escaped : retchar = escape. + +sure escaped : + IF escaped THEN cl eop (1, 20); cursor (1, 22); + yes ("Vorgang abbrechen", TRUE) + ELSE FALSE + FI. + +partition gueltig : + partition > 0 + AND partition <= max partitions. + +freie zylinder : + zylinder - belegte zylinder. + +belegte zylinder : + help := 0; + FOR i FROM 1 UPTO partitions REP + help INCR partition groesse (part list (i)) + PER; + help. + +keine eumel partition : + fehler; + put line ("Sie dürfen mit diesem System nur 'EUMEL' - Partitionen manipulieren."); + put ("Die Partition " + text (partition) + " ist nicht vom Typ 'EUMEL' !"). + +fehler : + cl eop (1, 20); + put (""7"" + inverse ("FEHLER :")); line (2). + +loesche eingabepuffer : + REP UNTIL incharety = "" PER. ; + +PROC logo : + page; + put center (3, "S E T U P - E U M E L "+ setup version); + put center (5, "für"); + put center (7, "M O D U L - S H A R D"); + put center (13, "======================================================"); + put center (15, "(für IBM " + typ + " und Kompatible)"); + put center (20, stand); + pause (50); + collect heap garbage. + +typ : + IF at version THEN "AT" ELSE "XT" FI. +END PROC logo; + +END PACKET setup eumel; + +setup eumel + + + + + + + -- cgit v1.2.3