(**************************************************************************)
(***** Zusammenbau eines SHards aus Modulen mit Dialog *****************)
(***** Copyright (c) 1987, 1988 by *****************)
(***** Lutz Prechelt, Karlsruhe *****************)
(**************************************************************************)
PACKET setup eumel shardmontage (* Copyright (c) 1987 by *)
DEFINES build shard, (* Lutz Prechelt, Karlsruhe *)
add bad sector table to shard, (* Stand : 08.04.88 3.2 *)
installation nr, (* Eumel 1.8.1 *)
print configuration :
(* Beschreibung des SHard-Hauptmodulformats siehe "modulkonfiguration" *)
(* In diesem Paket sind viele Namenskonventionen verankert.
Das leere SHard-Hauptmodul hat den Namen "SHard leer", teilaufgebaute
SHards heissen normalerweise in der Form "SHard 07.07.87 14:34" (andere
Namen sind möglich, wenn sie mit "SHard " beginnen.)
Die Prozedur build shard bastelt in Dialogsteuerung durch den Benutzer
aus Modulen und einem leeren oder teilaufgebauten SHard-Hauptmodul einen
neuen SHard zusammen und schreibt ihn in die Datei SHARD
Die Prozedur add bad block table to shard fügt einem so zusammengebauten
SHard eine bad block tabelle gemäß dem Zustand der Partition hinzu oder
ändert die vorhandene.
Dann ist der SHard komplett fertig zum auf-die-Partition-schleudern.
(einschliesslich Installationsnummer)
*)
LET hauptmodul namentyp = "SHard *",
(*modul namentyp = "SHardmodul *",*)
shard name = "SHARD";
LET bad sector table size = 1024, (* Entries *)
max sh length = 60, (* Blocks, vorläufig !!! *)
nr of channels total = 40,
offset shard length = 6,
offset bad sector table pointer = 8,
offset verbal identification = 176, (* Start Shardleiste *)
offset id 4 = 196; (* 176 + 14h *)
INT VAR actual installation nr :: id (5);
DATASPACE VAR ds :: nilspace;
PROC build shard (DATASPACE CONST old shard ds) :
(* Der Aufrufer muß hinterher nachsehen, ob es die Datei SHARD auch
wirklich gibt. Falls nicht, ist "Aufbau des SHards war nicht möglich"
zu melden.
*)
BOUND MODUL VAR old shard :: old shard ds, new shard;
TEXT VAR t;
INT VAR i;
THESAURUS VAR th, modules, automatic mode modules,
modules in old shard, modules in new shard;
BOOL CONST old shard valid :: int (old shard, offset id 4) = id (4) AND
verbal identification ok;
perhaps take old shard; (* ggf. LEAVE *)
get main module name in t;
copy (t, shard name);
new shard := old (shard name);
enable stop;
eliminate bad sector table from shard (new shard);
get module names;
configurate modules and build shard;
add ids.
verbal identification ok :
text (old shard, offset verbal identification, 16) =
"SHard Schoenbeck".
perhaps take old shard :
kopf;
forget (shard name, quiet);
IF old shard valid CAND
yes ("Wollen Sie den SHard genauso wie beim letzten Setup", FALSE)
THEN copy (old shard ds, shard name); LEAVE build shard
ELSE out (""10"") FI.
get main module name in t :
putline (" A u s w a h l d e s S H a r d - H a u p t m o d u l s "10"");
th := all LIKE hauptmodul namentyp;
IF highestentry (th) > 1
THEN let the user select one
ELSE take the only one FI.
let the user select one :
putline ("Wählen Sie jetzt bitte, welches SHard-Hauptmodul Sie als");
putline ("Ausgangspunkt der Konfiguration benutzen möchten.");
putline ("(Namen durch Zeiger auswählen dann RETURN-Taste drücken)");
t := ONE th;
out (""4""13""10""10""10"").
take the only one :
t := name (th, 1);
putline ("Das einzige verfügbare SHard Hauptmodul ist");
putline (t);
pause (30).
get module names :
(* Besorgt die Listen 1. vorhandene Module 2. Module im alten SHard
und 3. Module im SHard Hauptmodul
Liefert in modules eine Auswahl von 1. ohne 3. mit 2. als Vorschläge
und in automatic mode modules eine Auswahl von 2. (alles vorgeschlagen)
Die Liste 2. ist dabei so sortiert, daß stets eingekettete Module in der
richtigen Reihenfolge auftauchen.
*)
kopf;
put ("Ich untersuche den SHard: ");
get modules in shard (new shard, modules in new shard);
IF old shard valid
THEN get modules in shard (old shard, modules in old shard)
ELSE modules in old shard := empty thesaurus FI;
kopf;
putline ("Wählen Sie jetzt bitte mit RETURN/rauf/runter, welche Module Sie");
putline ("mit in den SHard aufnehmen möchten.");
putline ("(Zum Verlassen ESC q)");
modules := certain (all modules - modules in new shard,
modules in old shard);
IF old shard valid
THEN kopf;
putline ("Wählen Sie jetzt, welche der Module vollautomatisch wie im");
putline ("Vorlage-SHard konfiguriert werden sollen (Reihenfolge egal)");
automatic mode modules := certain (modules / modules in old shard,
modules in old shard)
ELSE automatic mode modules := empty thesaurus FI.
configurate modules and build shard :
FOR i FROM 1 UPTO highest entry (modules) REP
page; cout (i); collect heap garbage;
t := name (modules, i);
configurate module (new shard, old shard,
modules in old shard CONTAINS t,
automatic mode modules CONTAINS t, t)
PER;
IF highest entry (automatic mode modules) < highest entry (modules)
THEN perhaps keep copy of partly build shard FI;
collect heap garbage.
perhaps keep copy of partly build shard :
kopf;
storage info;
out (""10"Möchten Sie eine zusätzliche Kopie des SHard in dieser Version"13""10"");
IF yes ("aufheben", FALSE)
THEN TEXT CONST start :: subtext (hauptmodul namentyp, 1,
LENGTH hauptmodul namentyp - 1);
t := date;
put ("Gewünschter Name :"); out (start); editget (t); out (""13""10"");
t := start + t;
IF NOT exists (t) COR overwrite THEN copy (shard name, t) FI
FI.
add ids :
int (new shard, offset id 4 + 2 (* ID5 *), actual installation nr);
int (new shard, offset id 4 + 4 (* ID6 *), id (6));
int (new shard, offset id 4 + 6 (* ID7 *), id (7)).
overwrite :
IF yes ("Existierende Datei """ + t + """ überschreiben", FALSE)
THEN forget (t, quiet);
TRUE
ELSE FALSE FI.
END PROC build shard;
(******************** print configuration **********************************)
PROC print configuration (DATASPACE CONST old shard ds, BOOL CONST on screen):
(* Ruft für alle Module, die in old shard ds und als Datei vorhanden sind
print configuration aus dem Paket modulkonfiguration auf.
Macht bei on screen nach jedem Modul eine Pause, andernfalls wird die
Ausgabe in einem Rutsch gemacht und mit indirect list auf den Drucker
umgeleitet.
*)
BOUND MODUL VAR old shard :: old shard ds;
THESAURUS VAR modules in old shard;
BOOL CONST old shard valid :: int (old shard, offset id 4) = id (4) AND
verbal identification ok;
enable stop;
IF NOT old shard valid
THEN errorstop ("Der SHard ist ungültig");
LEAVE print configuration
FI;
write head ("Anzeigen der Konfiguration des SHard");
put ("Bitte fassen Sie sich in Geduld");
get modules in shard (old shard, modules in old shard);
out (""4""13""10""); (* clear cout, line *)
IF on screen
THEN putline ("Nach jedem Modul eine Taste drücken.")
ELSE putline ("Die Ausgabe geht zum Drucker");
indirect list (TRUE);
putline ("***** SHardkonfiguration *****"); line;
FI;
disable stop;
do print configuration (old shard, modules in old shard, on screen);
IF is error THEN put error; pause; clear error FI;
enable stop;
IF NOT on screen THEN indirect list (FALSE) FI.
verbal identification ok :
text (old shard, offset verbal identification, 16) =
"SHard Schoenbeck".
END PROC print configuration;
PROC do print configuration (MODUL CONST old shard,
THESAURUS CONST modules in old shard,
BOOL CONST on screen) :
INT VAR i;
TEXT VAR t;
enable stop;
FOR i FROM 1 UPTO highest entry (modules in old shard) REP
t := name (modules in old shard, i);
print configuration (old shard, t);
collect heap garbage;
IF on screen THEN pause FI
PER.
END PROC do print configuration;
(********************** modules in shard **********************************)
PROC get modules in shard (MODUL CONST old shard,
THESAURUS VAR modules in old shard) :
(* Stellt einem THESAURUS zusammen, der aus den Namen aller in old shard
enthaltenen Module besteht (ohne Duplikate).
Dabei sind diejenigen Modulnamen, deren Treiber in old SHard nicht als
eingekettete Treiber vorkommen, im Resultat VOR den eingeketteten
(d.h. mit kleineren link-Nummern) zu finden, um die richtige
Konfigurationsreihenfolge vorschlagen zu können.
Es muß zuvor bereits einmal init modules list aufgerufen worden sein !
*)
INT VAR kanal;
REAL VAR p dtcb, p ccb;
TEXT VAR type, m name;
THESAURUS VAR simple :: empty thesaurus, chained :: empty thesaurus;
FOR kanal FROM 0 UPTO nr of channels total - 1 REP
cout (kanal);
p dtcb := sh dtcb offset (old shard, kanal);
p ccb := sh ccb offset (old shard, kanal);
look at this chain
PER;
invert chained thesaurus;
modules in old shard := what comes out when i let nameset do all the hard
work for me with a little trick and knowledge of implementation.
look at this chain :
(* Das Verfahren ist auf den ersten Blick etwas kompliziert, spart aber
einiges an Kodeduplikation
*)
m name := "";
WHILE p dtcb <> 0.0 AND p ccb <> 0.0 REP
IF m name <> "" AND NOT (chained CONTAINS m name)
THEN insert (chained, m name) FI;
type := text (old shard, p dtcb, 4);
m name := module name (type);
p dtcb := unsigned (int (old shard, p ccb + 2.0)); (* verkettet *)
p ccb := unsigned (int (old shard, p ccb + 4.0));
PER;
IF m name <> "" THEN insert (simple, m name) FI.
invert chained thesaurus :
(* bis jetzt sind bei mehrfachen Verkettungen die zuletzt eingeketteten
Treiber als erstes eingetragen, das darf jedoch nicht so bleiben
*)
INT VAR i;
THESAURUS VAR help :: empty thesaurus;
FOR i FROM highest entry (chained) DOWNTO 1 REP
insert (help, name (chained, i))
PER;
chained := help.
what comes out when i let nameset do all the hard
work for me with a little trick and knowledge of implementation :
(* Beware of false algebraic identities ! These are neither numbers nor
sets but lists (ordered and not duplicate-free)
*)
empty thesaurus + (simple - chained) + chained.
END PROC get modules in shard;
(*************** add bad sector table to shard ****************************)
PROC add bad sector table to shard (INT CONST eumel type,
DATASPACE CONST shard ds,
BOOL CONST take from partition,
INT VAR bad sector count) :
(* Fügt einem SHard eine bad sector table hinzu oder ändert sie.
Ist noch keine vorhanden, so sollte der Zeiger 0 sein.
*)
ROW bad sector table size REAL VAR bst;
BOUND MODUL VAR new shard :: shard ds;
REAL VAR new shard length, offset bst;
INT VAR i;
enable stop;
IF take from partition
THEN put ("kopiere Tabelle :");
find bst in shard on partition
ELSE put ("Spur :");
get bad sector table (bst, bad sector count, eumel type);
FI;
eliminate bad sector table from shard (new shard);
new shard length := unsigned (int (new shard, offset shard length));
int (new shard, new shard length, bad sector count);
int (new shard, offset bad sector table pointer, unsigned (new shard length));
new shard length INCR 2.0;
IF take from partition
THEN copy bst from old to new shard
ELSE write bst to new shard FI;
int (new shard, offset shard length, unsigned (new shard length)).
copy bst from old to new shard :
copy (old shard, offset bst + 2.0, new shard, new shard length,
bad sector count * 4);
cout (bad sector count * 4);
new shard length INCR real (bad sector count * 4).
write bst to new shard :
FOR i FROM 1 UPTO bad sector count REP
cout (i);
enter bad sector low word
PER;
FOR i FROM 1 UPTO bad sector count REP
cout (i);
enter bad sector high word;
PER.
find bst in shard on partition :
cout (0);
read file (ds, start of partition (eumel type) + 1.0, max sh length,
setup channel);
BOUND MODUL CONST old shard :: ds;
IF int (old shard, offset id 4) <> id (4)
THEN errorstop ("SHard auf Partition unbrauchbar") FI;
offset bst := unsigned (int (old shard, offset bad sector table pointer));
bad sector count := int (old shard, unsigned (offset bst)).
enter bad sector low word :
int (new shard, new shard length, low word (bst [i]));
new shard length INCR 2.0.
enter bad sector high word :
int (new shard, new shard length, high word (bst [i]));
new shard length INCR 2.0.
END PROC add bad sector table to shard;
(************ eliminate bad sector table from shard ****************)
PROC eliminate bad sector table from shard (MODUL VAR shard) :
(* Entfernt die bad sector table (bst) aus dem shard falls sie sich am Ende
desselben befindet. Trägt korrekte neue Werte für den bst pointer und
shard laenge ein.
*)
REAL VAR shard length :: unsigned (int (shard, offset shard length)),
bst offset :: unsigned (int (shard, offset bad sector table pointer));
LET bst entry length = 4.0; (* bst entries sind Wort-Paare *)
IF bst offset = 0.0
THEN (* ist gar keine bst vorhanden, also schon prima eliminiert *)
ELIF bst ist am ende
THEN bst entfernen FI;
bst austragen.
bst ist am ende :
bst offset + bst entry length * nr of bst entries + 2.0 =
shard length.
nr of bst entries :
unsigned (int (shard, bst offset)).
bst entfernen :
int (shard, offset shard length, unsigned (bst offset)).
bst austragen :
int (shard, offset bad sector table pointer, 0).
END PROC eliminate bad sector table from shard;
(******************* installation nr *************************************)
INT PROC installation nr :
actual installation nr
END PROC installation nr;
PROC installation nr (INT CONST new) :
actual installation nr := new
END PROC installation nr;
(*********************** Hilfsprozeduren **********************************)
PROC kopf :
write head ("M o d u l - S H a r d Zusammenbau eines SHard").
END PROC kopf;
END PACKET setup eumel shardmontage;