(**************************************************************************)
(***** Ergänzung des SHards um ein Modul (mit Dialog) *****************)
(***** Copyright (c) 1987, 1988 by *****************)
(***** Lutz Prechelt, Karlsruhe *****************)
(**************************************************************************)
PACKET setup eumel modulkonfiguration (* Copyright (c) by *)
DEFINES configurate module, (* Lutz Prechelt, Karlsruhe *)
print configuration, (* Eumel 1.8.1 *)
give me, take you, (* Stand : 12.07.88 3.2 *)
new index,
perform dtcb dialogue,
perform ccb dialogue,
(* für Modulprogrammierer : *)
write info,
channel free,
reserve channel,
channels of this module,
buffer address :
(* Dieses Modul führt den kompletten Dialog mit dem Benutzer durch, der
nötig ist, um alle Kanäle, die mit demselben Modul laufen sollen, zu
konfigurieren.
Verfahren :
im alten SHard den dtcb suchen
dtcb und Modul im neuen SHard eintragen
dtcb mit oder ohne Vorbild konfigurieren
alle ccbs zu dem Modul im alten SHard suchen und Kanalnummern merken
Auswahl einer Kanalmenge durch Benutzer mit alten als Vorschlag
ccbs in neuen SHard kopieren
ccbs mit oder ohne Vorbild konfigurieren
Kanaltabelle auf den neuen Stand bringen
neuen Shard und seine geänderte Länge zurückgeben
Dabei kann der "Dialog" bei geeigneten Rahmenbedingungen durch bloßes
Übertragen der Werte aus einem Vorlage-SHard ersetzt werden, wenn der
Benutzer dies wünscht (want automatic mode). Dann geht alles von selbst.
(....kaufen Sie Setup-Eumel und es geht alles wie von selbst !)
Format des SHard-Hauptmoduls :
1. (Byte 0-2) jmp boot (3 Byte)
2. (Byte 3) reserviert
3. (Byte 4) SHard-Version
4. (Byte 5) SHard-Release
5. (Byte 6/7) SHardlänge (2 Byte)
6. (Byte 8/9) Verweis auf Bad-Block Tabelle (2 Byte)
7. (Byte 10/11) Verweis auf Kanaltabelle
8. (Byte 16-175) Eumelleiste
9. (Byte 176-299) SHardleiste
10. (ab Byte 300) Shardhauptmodulroutinen und -daten
11. (danach) Rumpf des Hauptmoduls mit Bad-Block-Tabelle,
Kanaltabelle, Routinen und Daten
12. (danach) Folge der Module (bis Byte SHardlänge - 1)
Kanaltabelle:
feste Länge 40 Einträge "nr of channels total" (Kanal 0 bis Kanal 39)
jeder Eintrag besteht aus : (alles 2 Byte)
offset dtcb, offset ccb
Achtung : Dieses Programm schmiert bei SHards über 32767 Byte Länge
eventuell ab (es hat noch niemand probiert) !
Abkürzungen: cb steht für control block und meint entweder ccb oder dtcb
Implementationsanmerkung :
Bei der Verwendung von THESAURUS wird von dem Wissen über die Art der
Implementation derselben Gebrauch gemacht, indem folgende Annahmen in den
Code eingehen:
1. Bei einem THESAURUS, in dem nicht gelöscht wurde, ist highest entry gleich
der Kardinalität
2. außerdem entspricht dann die Nummer (link) eines Eintrags seinem
Eintragszeitpunkt, d.h. der Position in der Eintragsfolge
3. + und - liefert THESAURi, in denen nicht gelöscht wurde und die Eintrags-
reihenfolge ist wie von den Parametern vorgegeben (bei + links zuerst)
4. certain und ONE liefern THESAURi, in denen nicht gelöscht wurde.
*)
(************************* Daten ********************************)
LET nr of channels total = 40, (* SHard Tabellenlänge *)
mdts = 40, (* max dialogtable size in INTs *)
mchm = 20, (* max channels for module *)
offset sh version = 4,
offset sh structureversion = 5,
offset shardlength = 6,
do name = "PrOgRaM tO Do";
LET UNSIGNED = INT,
VARIABLES = ROW mdts ROW mchm INT;
TEXT CONST variables var xxv :: "ROW " + text (mdts) + " ROW "+
text (mchm) + " INT VARxxv;";
VARIABLES VAR v; (* siehe give me / take you *)
INT VAR max index; (* Information für new index *)
INT VAR channels of module; (* Information für channels of this module *)
TEXT VAR actual info; (* fuer write info *)
ROW 256 INT VAR channel table of new shard; (* für channel free *)
DATASPACE VAR dummy ds; (* für print configuration *)
REAL VAR new shard length;
(***************************************************************************)
(************* Hier geht's los...... ***************************************)
(***************************************************************************)
(******************** configurate module **********************************)
PROC configurate module (MODUL VAR new shard, MODUL CONST old shard,
BOOL CONST old shard valid, want automatic mode,
TEXT CONST modulname) :
do configurate module (new shard, old shard, old shard valid,
want automatic mode, modulname, FALSE)
END PROC configurate module;
(********************** print configuration *******************************)
PROC print configuration (MODUL CONST old shard, TEXT CONST modulname) :
(* Es ist hier schon sichergestellt, daß old shard valid ist und das Modul
auch im SHard enthalten
*)
forget (dummy ds); dummy ds := nilspace;
BOUND MODUL VAR dummy :: dummy ds;
do configurate module (dummy, old shard, TRUE, FALSE, modulname, TRUE);
forget (dummy ds).
END PROC print configuration;
(******************* do configurate module *********************************)
PROC do configurate module (MODUL VAR new shard, MODUL CONST old shard,
BOOL CONST old shard valid, want automatic mode,
TEXT CONST modulname,
BOOL CONST print configuration only):
(* In dieser Prozedur ist die Beschränkung auf Module mit unter 32kB
Länge ausgenutzt.
Ist kein alter SHard vorhanden, so muss ein leerer SHard übergeben
werden (d.h. alle Einträge in der Kanaltabelle sind 0).
Ein alter SHard darf keinesfalls unterschiedliche releases desselben
Modultyps enthalten.
Resultierende SHardgesamtlängen von über 32k sind noch nicht getestet.
*)
BOUND MODUL VAR m;
INT VAR (***** Daten über das neue Modul *****)
sh version, sh structure version, release,
max ccb, nr of ccbs,
dtcb table entries, offset dtcb table, (* Variablentabellen *)
ccb table entries, offset ccb table,
muster ccb length, offset muster ccb, (* Muster-ccb im Modul *)
module body length, (* Länge des zu kopierenden Modulrumpfs *)
offset module body, offset dtcb;
TEXT VAR modultyp; (* 4 Byte *)
INT VAR (***** Daten über den alten SHard *****)
old release :: -2; (* garantiert inkompatibel *)
REAL VAR offset old dtcb :: 0.0;
ROW nr of channels total REAL VAR offset old ccb;
BOOL VAR old cbs valid :: FALSE;
THESAURUS VAR old channels :: empty thesaurus;
(***** Daten über den neuen SHard *****)
REAL VAR dtcb location;
ROW nr of channels total REAL VAR ccb location;
(***** Sonstige Daten *****)
INT VAR i, k, kanal, ccb count;
BOOL VAR automatic mode, configurate :: NOT print configuration only;
reset direction (FALSE); (* zur Sicherheit *)
IF configurate
THEN new shard length := unsigned (int (new shard, offset shard length)) FI;
connect module;
get module data;
test sh version compatibility; (* ggf. LEAVE *)
(* Bisher wurde nur gelesen, ab jetzt darf nicht mehr abgebrochen werden *)
search old shard for module and find all old ccbs;
test release compatibility; (* ggf. LEAVE *)
IF configurate
THEN write module with dtcb to shard;
perhaps set automatic mode;
FI;
configurate dtcb;
IF configurate
THEN kopf;
select channels;
write ccbs to shard;
ELSE nr of ccbs := highest entry (old channels)
FI;
configurate ccbs;
IF configurate
THEN make entries in channeltable of new shard;
int (new shard, offset shardlength, unsigned (new shard length))
FI.
connect module :
m := old (modulname);
actual info := info (m);
IF configurate
THEN kopf
ELSE put ("-----"); put (modulname); putline ("-----")
FI.
get module data :
(* Format des Moduls in den ersten Bytes:
Byte Entry
0/1 offset dtcb variablen tabelle
2/3 offset ccb variablen tabelle
4/5 offset muster-ccb
6/7 offset modulrumpf
8/9 offset dtcb
10/11 max anzahl ccbs
die tabellen enthalten im ersten Wort die Anzahl ihrer Einträge
der modulrumpf und der ccb ihre Länge in Byte
die Länge der Tabellen ergibt sich aus den offset-Differenzen.
dtcb-Format : Modultyp (4 Byte)
SHardversion (1 Byte)
SHardstrukturversion (1 Byte)
Modulrelease (2 Byte) ....
*)
max ccb := int (m, 10);
offset dtcb table := int (m, 0);
dtcb table entries := int (m, offset dtcb table);
offset ccb table := int (m, 2);
ccb table entries := int (m, offset ccb table);
offset muster ccb := int (m, 4);
muster ccb length := int (m, offset muster ccb);
offset module body := int (m, 6);
module body length := int (m, offset module body);
offset dtcb := int (m, 8);
(*****
put (" offset dtcb table:"); put( offset dtcb table); line;
put (" dtcb table entrie:"); put( dtcb table entries); line;
put (" offset ccb table :"); put( offset ccb table); line;
put (" ccb table entrie:"); put( ccb table entries); line;
put (" offset muster ccb:"); put( offset muster ccb); line;
put (" muster ccb length:"); put( muster ccb length); line;
put (" offset module bod:"); put( offset module body); line;
put (" module body lengt:"); put( module body length); line;
put (" offset dtcb :"); put( offset dtcb); line;*****)
modultyp := text (m, offset dtcb, 4);
sh version := byte (m, offset dtcb + 4);
sh structureversion := byte (m, offset dtcb + 5);
release := int (m, offset dtcb + 6).
test sh version compatibility :
IF configurate AND NOT version is compatible
THEN putline ("Das Modul ist mit dieser SHard-Version nicht mehr verträglich.");
putline (""10""10""15" Installation des Moduls wird abgebrochen. "14""7""13""10"");
go on;
LEAVE do configurate module
FI.
version is compatible:
(* Kompatibel, wenn das Modul eine ältere oder gleiche sh version verlangt
und die gleiche sh structureversion
*)
sh version <= byte (new shard, offset sh version) CAND
sh structure version = byte (new shard, offset sh structureversion).
search old shard for module and find all old ccbs :
(* Es werden alle Kanäle des alten SHard untersucht, ob der dortige Treiber
den gleichen Modultyp hat und in diesem Fall die Kanalnummer in
"old channels" gesammelt, sowie offset old ccb gemerkt, im Nichterfolgs-
falle wird offset old ccb auf diesem Kanal 0 gesetzt.
Es werden auch alle verketteten Treiber untersucht.
Auch old cbs valid und offset old dtcb werden ggf. gesetzt.
*)
IF NOT old shard valid
THEN LEAVE search old shard for module and find all old ccbs FI;
IF configurate THEN put ("Ich untersuche den alten SHard :") FI;
FOR kanal FROM 0 UPTO nr of channels total - 1 REP
IF configurate THEN cout (kanal) FI;
collect ccbs on this channel
PER;
IF configurate THEN put (""13""5"") FI. (* Zeile löschen *)
collect ccbs on this channel :
REAL VAR p dtcb :: sh dtcb offset (old shard, kanal),
p ccb :: sh ccb offset (old shard, kanal);
WHILE p dtcb <> 0.0 AND p ccb <> 0.0 REP
BOOL CONST success :: text (old shard, p dtcb, 4) = modultyp;
IF success
THEN offset old dtcb := p dtcb;
old release := int (old shard, p dtcb + 6.0);
insert (old channels, text (kanal));
offset old ccb [kanal+1] := p ccb
ELSE p dtcb := unsigned (int (old shard, p ccb + 2.0)); (* verkettet *)
p ccb := unsigned (int (old shard, p ccb + 4.0))
FI
UNTIL success PER;
old cbs valid := old shard valid AND offset old dtcb <> 0.0 AND
(release = old release + 1 OR release = old release).
test release compatibility:
IF print configuration only AND NOT old cbs valid
THEN putline ("Kein Zugriff auf die Konfigurationsdaten möglich");
LEAVE do configurate module
FI.
write module with dtcb to shard :
put ("Modul """ + modulname + """ wird in den SHard eingetragen :");
IF int (new shard length MOD 2.0) <> offset module body MOD 2
THEN new shard length INCR 1.0 FI; (* kopiert so schneller *)
dtcb location := new shard length +
real (offset dtcb - offset module body);
copy (m, real (offset module body), new shard, new shard length,
module body length);
new shard length INCR real (module body length).
perhaps set automatic mode :
IF old cbs valid AND old release = release
THEN automatic mode := want automatic mode
ELSE automatic mode := FALSE FI.
configurate dtcb :
IF configurate
THEN kopf;
putline ("Konfiguration des Treibers :");
get new channel table (new shard, channel table of new shard);
FI;
perform dtcb dialogue (m, real (offset dtcb table+2), dtcb table entries,
new shard, dtcb location,
old shard, offset old dtcb,
old cbs valid, release = old release,
dtcb refinements (m), dtcb abfragen (m),
automatic mode, print configuration only).
select channels :
ccb count := highest entry (old channels);
k := min (ccb count, max ccb); (* .... Mutter der Porzellankiste *)
nr of ccbs := max (k, 1);
IF automatic mode THEN LEAVE select channels FI;
IF max ccb > 1
THEN REP
editget ("Wieviele Kanäle mit diesem Treiber (1 bis " +
text (max ccb) + ") : ", nr of ccbs);
out (""13"")
UNTIL nr of ccbs IN range (1, max ccb) PER;
out (""10""10"")
ELSE nr of ccbs := 1 FI;
IF nr of ccbs < ccb count (* weniger als früher *)
THEN put ("Wählen Sie mindestens"); putline (x kanäle aus deren);
putline ("Werte nicht als Vorbesetzung angeboten werden sollen"10"");
REP
THESAURUS CONST help :: certain (old channels, empty thesaurus);
IF NOT enough refused THEN out (""7"") FI
UNTIL enough refused PER;
old channels := old channels - help;
out (""3""3""3""4"") (* clear screen from incl. "Wählen..." on *)
FI.
x kanäle aus deren :
IF ccb count - nr of ccbs > 1
THEN text (ccb count - nr of ccbs) + " Kanäle aus, deren"
ELSE "einen Kanal aus, dessen" FI.
enough refused :
highest entry (help) >= ccb count - nr of ccbs.
write ccbs to shard :
(* Ausserdem wird hier ccb location vorbereitet *)
out ("Die Kanäle werden in den neuen SHard eingetragen : ");
FOR i FROM 1 UPTO nr of ccbs REP
ccb location [i] := new shard length;
copy (m, real (offset muster ccb + 2), new shard, new shard length,
muster ccb length);
new shard length INCR real (muster ccb length)
PER.
configurate ccbs :
(*put (old shard valid); put ("Release:"); put (release); put (" old release:"); put (old release);
put (old cbs valid); pause;*)
IF configurate
THEN out (""13""10"Konfiguration der Kanäle:"13""10"");
get new channel table (new shard, channel table of new shard)
FI;
ccb count := 0;
FOR kanal FROM 0 UPTO nr of channels total REP
IF old channels CONTAINS text (kanal)
THEN ccb count INCR 1;
offset old ccb [ccb count] := offset old ccb [kanal+1]
FI
PER;
FOR i FROM ccb count + 1 UPTO nr of ccbs REP
offset old ccb [i] := 0.0
PER;
perform ccb dialogue (m, real (offset ccb table+2), ccb table entries,
new shard, ccb location,
old shard, offset old ccb,
nr of ccbs,
offset old dtcb <> 0.0, release = old release,
ccb refinements (m), ccb abfragen (m),
automatic mode, print configuration only).
make entries in channeltable of new shard :
kopf;
out ("Konfigurationsdaten werden in den neuen SHard eingetragen : ");
FOR i FROM 1 UPTO nr of ccbs REP
cout (i);
kanal := (*v[1][i]falsch???!!!*) byte (new shard, ccb location [i]);
make entry in channeltable of new shard
PER.
make entry in channeltable of new shard :
IF NOT channel free (kanal)
THEN (* dtcb/ccb Adresse aus channel table nach neuem ccb umtragen. *)
int (new shard, ccb location [i] + 2.0,
unsigned (sh dtcb offset (new shard, kanal)));
int (new shard, ccb location [i] + 4.0,
unsigned (sh ccb offset (new shard, kanal)));
ELSE (* Folge-dtcb/ccb Adresse auf 0 setzen *)
int (new shard, ccb location [i] + 2.0, 0);
int (new shard, ccb location [i] + 4.0, 0);
FI;
(* Jetzt neue Adresse in channel table eintragen *)
sh dtcb offset (new shard, kanal, dtcb location);
sh ccb offset (new shard, kanal, ccb location [i]);
k := byte (new shard, ccb location [i] + 1.0); (* Zusatzkanalnummer *)
IF k <> 255 (* 255 = kein Zusatzkanal vorhanden *)
THEN (* IF NOT channel free (k) THEN alter eintrag futsch !!! *)
sh dtcb offset (new shard, k, dtcb location);
sh ccb offset (new shard, k, ccb location [i])
FI.
kopf :
write head ("""" + modulname + """ in den SHard aufnehmen");
out (actual info);
out (""13""10"").
END PROC do configurate module;
(********************* perform dialogue ************************************)
PROC perform dtcb dialogue
(MODUL VAR m, REAL CONST offset dialogue table,
INT CONST dialogue table entries,
MODUL VAR dtcb, REAL CONST offset dtcb,
MODUL CONST old dtcb, REAL CONST offset old dtcb,
BOOL CONST old dtcb valid, same release,
TEXT CONST refinements, INT CONST count,
BOOL CONST automatic mode, print configuration only):
ROW nr of channels total REAL VAR offset cb, offset old cb;
offset cb [1] := offset dtcb;
offset old cb [1] := offset old dtcb;
perform dialogue (TRUE, m, offset dialogue table, dialogue table entries,
dtcb, offset cb, old dtcb, offset old cb, 1,
old dtcb valid, same release, refinements, count,
automatic mode, print configuration only).
END PROC perform dtcb dialogue;
PROC perform ccb dialogue
(MODUL VAR m, REAL CONST offset dialogue table,
INT CONST dialogue table entries,
MODUL VAR ccb, ROW nr of channels total REAL CONST offset ccb,
MODUL CONST old ccb, ROW nr of channels total REAL CONST offset old ccb,
INT CONST nr of ccbs, BOOL CONST old ccbs valid, same release,
TEXT CONST refinements, INT CONST count,
BOOL CONST automatic mode, print configuration only) :
perform dialogue (FALSE, m, offset dialogue table, dialogue table entries,
ccb, offset ccb, old ccb, offset old ccb, nr of ccbs,
old ccbs valid, same release, refinements, count,
automatic mode, print configuration only).
END PROC perform ccb dialogue;
PROC perform dialogue
(BOOL CONST is dtcb,
MODUL VAR m, REAL CONST offset dialogue table,
INT CONST dialogue table entries,
MODUL VAR cb, ROW nr of channels total REAL CONST offset cb,
MODUL CONST old cb, ROW nr of channels total REAL CONST offset old cb,
INT CONST nr of cbs, BOOL CONST old cb valid, same release,
TEXT CONST refinements, INT CONST refinement count,
BOOL CONST automatic mode, print configuration only) :
(* Konfigurationsdialog für einen (Satz von) Kontrollblock(s) oder bloßes
Anzeigen der Konfigurationsdaten derselben.
1. bei NOT print configuration only:
Führt den Dialog für eine Tabelle (also ccb oder dtcb Variablentabelle)
durch und bestückt den controlblock entsprechend.
Es wird gleich eine ganze Tabelle von controlblocks (max. mchm Stück)
abgearbeitet und zwar nr of cbs Stück; im Falle is dtcb wird natürlich
nur der Eintrag 1 der Tabellen benutzt (vom Aufrufer).
Das Eingabemodul ist m mit der zu bearbeitenden Tabelle an der Stelle
offset dialogue table. Die Tabelle enthält dialogue table entries
Einträge (max. mdts Stück !)
Die Ausgabe des Prozesses landet im Modul cb ab den Stellen offset cb.
cb ist dabei jeweils der neue SHard, damit man nicht das Modul ändert.
Die Vorlagen zum Abgucken liefert, falls old cb valid ist, das
Modul old cb (der alte SHard) ab offset old cb, dabei ist die Struktur
gleich der neuen, wenn same release gilt, andernfalls sind die
Vorversionsoffsets zu benutzen (Versionsnummer um genau 1 erhöht).
Bei automatic mode werden nur still diese Vorgabewerte übernommen.
Die Elan-Teile für den Dialog liefert schliesslich der Text refinements,
er enthält refinement count Abfragen der Namen r1, r2, .....
Wenn refinent count = 0 ist, passiert hier eigentlich nichts,
deshalb sollte dann
für eine korrekte Initialisierung auch die Variablentabelle leer sein;
ist sie es allerdings doch nicht, werden hier noch die Standardwerte in
die ccbs eingetragen und nur der leere Dialog unterdrückt.
Vor Beginn/Nach Ende des gesamten Dialogs wird das refinement
dialoguestart/dialogueend aufgerufen; bei NOT is dtcb vor/nach dem Dialog
jedes Kanals auch noch channelstart/channelend.
2. bei print configuration only:
Die Daten zum new shard werden überhaupt nicht benutzt, von den
refinements wird nur für jeden Kanal einmal "print configuration"
aufgerufen.
*)
REAL VAR table byte :: offset dialogue table;
ROW mdts INT VAR offset, old offset, length;
INT VAR i, k;
BOOL VAR configurate :: NOT print configuration only;
TEXT VAR program, t;
IF print configuration only (* Hier wird evtl. schon verlassen *)
THEN startup for print
ELSE startup for dialogue FI;
IF refinement count > 0 THEN build program FI;
build data in v;
IF refinement count > 0 THEN do program FI;
IF configurate THEN put values in cb FI.
startup for print :
IF refinement count = 0 OR dialogue table entries = 0
THEN LEAVE perform dialogue FI.
startup for dialogue:
IF refinement count = 0
THEN putline ("Keine Konfiguration notwendig.");
IF dialogue table entries = 0
THEN pause (20); LEAVE perform dialogue FI
ELSE putline ("Die Konfiguration wird vorbereitet.") FI.
build program:
max index := refinement count; (* damit new index bescheid weiss *)
program := variables var xxv;
program cat main part;
perhaps program cat data refinements;
program CAT refinements.
program cat main part :
program CAT "LET UNSIGNED=INT;giveme(xxv);INT VARxxi::1,actchannel;";
IF print configuration only OR automatic mode
THEN program cat main part for print or automatic mode
ELSE program cat main part for dialogue FI.
program cat main part for print or automatic mode:
(* Leider muss man, wenn man den Modulprogrammierer bei den .ccb und .dtcb
Teilen nicht zu stark reglementieren will, einiges mitübersetzen, was
dann gar nicht benutzt wird (z.B. alle Refinements).
Und der Gedanke macht ihn blaß,
wenn er fragt: was kostet das ?
Wilhelm Busch
*)
program CAT "FORactchannelFROM 1 UPTOchannelsofthismoduleREP";
IF print configuration only
THEN program CAT "printconfigurationPER."
ELSE (* automatic mode: *) program CAT "automaticPER;takeyou(xxv)."
FI;
program CAT " xxa:actchannel. thischannel:";
IF NOT is dtcb THEN program CAT "channelstart;" FI;
FOR i FROM 1 UPTO refinement count REP
program CAT "r"; (* Alle in this channel aufrufen, damit *)
program CAT text (i); (* "LEAVE this channel" kein Fehler ist. *)
program CAT ";"
PER;
IF NOT is dtcb
THEN program CAT "channelend" FI;
program CAT ". ".
program cat main part for dialogue:
program CAT "dialoguestart;FORactchannelFROM 1 UPTOchannelsofthismoduleREP";
program CAT "thischannelPER;dialogueend;takeyou(xxv). ";
program CAT "xxa:actchannel. thischannel:";
IF NOT is dtcb THEN program CAT "channelstart;" FI;
program CAT "REP SELECTxxiOF ";
FOR i FROM 1 UPTO refinement count REP
program CAT "CASE ";
program CAT text (i);
program CAT ":r";
program CAT text (i);
program CAT " "
PER;
program CAT "ENDSELECT UNTIL NOTnewindex(xxi)PER";
IF NOT is dtcb
THEN program CAT ";channelend;reservechannel(xxv[1][xxa])" FI;
program CAT ". ".
perhaps program cat data refinements :
FOR i FROM 1 UPTO dialogue table entries REP
IF configurate THEN cout (i) FI;
read start of next table entry; (* must be done in autom. mode, too, *)
t := next variable name; (* to get offset/oldoffset/length [i] *)
program CAT t;
program CAT ":xxv[";
program CAT text (i);
program CAT "][xxa]. "; (* Das war der normale Eintrag "varname" *)
program CAT t; (* Jetzt der für alle Kanäle "varname k" *)
program CAT "k:xxv[";
program CAT text (i);
program CAT "]. "
PER.
read start of next table entry :
(* Format der Einträge in den Variablentabellen:
dw offset in cb
dw offset in old cb (oder ffffh falls neu)
db Typ (d.h. Länge und ist 1 oder 2)
db Namenslänge
db ...(Name)...
*)
INT CONST length of variable :: byte (m, table byte + 4.0),
length of name :: byte (m, table byte + 5.0);
old offset [i] := int (m, table byte + 2.0); (* Diese Sammlung *)
offset [i] := int (m, table byte); (* bereitet das Datenholen vor *)
length [i] := length of variable;
IF length of variable < 1 OR length of variable > 2
THEN errorstop ("invalid variablelength : " + text (length of variable))
FI;
table byte INCR 6.0.
next variable name:
table byte INCR real (length of name);
text (m, table byte - real (length of name), length of name).
build data in v :
FOR k FROM 1 UPTO nr of cbs REP (* Kanäle *)
IF configurate THEN cout (k) FI;
FOR i FROM 1 UPTO dialogue table entries REP (* Variablen *)
v[i][k] := next init value
PER
PER.
next init value :
IF old cb valid CAND old cb present CAND value accessible
THEN value from old cb
ELSE value from new cb FI.
old cb present :
offset old cb [k] > 0.0.
value accessible :
same release OR
(* Ein release zuvor und Variable gibts schon: *) old offset [i] <> -1.
value from old cb :
IF length [i] = 1
THEN byte (old cb, offset old cb [k] + real (offset of old value))
ELSE int (old cb, offset old cb [k] + real (offset of old value))
FI.
value from new cb :
IF length [i] = 1
THEN byte (cb, offset cb [k] + real (offset [i]))
ELSE int (cb, offset cb [k] + real (offset [i])) FI.
offset of old value :
IF same release
THEN offset [i]
ELSE old offset [i] FI.
do program :
reset direction (TRUE);
channels of module := nr of cbs;
IF setup testing
THEN (* für diesen THEN-Teil beim abgespeckten Eumel
setup eummel mini eumel dummies insertieren *)
forget (do name, quiet);
FILE VAR f := sequentialfile (output, do name);
putline (f, program);
(*edit (do name);*)
run (do name);
forget(do name, quiet);
ELSE do (program);
FI;
program := ""; (* Platz sparen *)
reset direction (FALSE).
put values in cb :
FOR k FROM 1 UPTO nr of cbs REP
cout (k);
FOR i FROM 1 UPTO dialogue table entries REP
IF length [i] = 1 THEN put byte ELSE put int FI
PER;
PER.
put byte :
byte (cb, offset cb [k] + real (offset [i]), v[i][k]).
put int :
int (cb, offset cb [k] + real (offset [i]), v[i][k]).
END PROC perform dialogue;
(****************** give me, take you, new index ***************************)
(* Diese Prozeduren werden aus dem do beim perform dialogue heraus aufgerufen
Sie dienen zur Kommunikation mit den Paketdaten dieses Pakets (give me,
take you) oder zur Verkleinerung des do-Programms (new index)
*)
PROC give me (VARIABLES VAR variables) :
(* Der Sinn dieser Prozedur besteht in Folgendem :
bei perform dialogue wird in dem do, das die refinements des
SHard-Moduls ausführt, eine Datenstruktur vom Typ VARIABLES aufgebaut,
die alle in den Variablentabellen des Moduls aufgeführten Variablen
enthält und einzeln über passend benannte refinements zugänglich macht.
Diese Datenstruktur wird zuvor in diesem Paket hier initialisiert mit
Initwerten aus der Variablentabelle oder wenn möglich mit den
entsprechenden Werten aus dem alten SHard. Mit give me fordert das
do-Programm die initialisierte Datenstruktur aus diesem Paket hier an.
Im do wird am Schluss mit take you diese Datenstruktur an dieses Paket
(und damit an perform dialogue) zurückgegeben, damit die durch den
Dialog gesetzten Werte in den neuen SHard eingetragen werden können.
Eine alternative Methode, diese Kommunikation zu realisieren, wäre die
Benutzung von BOUND VARIABLES VARs mit demselben Datenraum.
*)
variables := v
END PROC give me;
PROC take you (VARIABLES CONST variables) :
(* Gegenstück zu give me, siehe dort *)
v := variables
END PROC take you;
BOOL PROC new index (INT VAR index) :
(* Verändert den Index je nach der direction und fragt bei down am Ende,
ob fertig. Liefert, ob es noch weitergehen soll (falls nein: index = 1)
*)
LET up = ""3"",
down = ""10"",
error = ""0"";
TEXT CONST old direction :: direction;
reset direction (TRUE);
IF old direction = error (* Bei Fehlern immer stehenbleiben *)
THEN TRUE
ELIF index = max index (* am Schluss aufhören oder nach 1 springen *)
THEN perhaps end
ELIF index = 1 AND old direction = up (* bei 1 und up an den Schluss *)
THEN index := max index; TRUE
ELSE normal new index (* sonst je nach direction up oder down *)
FI.
perhaps end : (* index = max index *)
IF old direction = up AND max index > 1 (* hoch vom Ende *)
THEN index DECR 1;
TRUE
ELIF old direction = up
THEN TRUE
ELIF old direction = down (* runter am Ende *)
THEN index := 1;
TRUE
ELSE reset direction (FALSE); (* normal oder runter ans Ende *)
index := 1;
BOOL CONST ready :: yes (1, 23, "Fertig", FALSE);
reset direction (TRUE);
NOT ready
FI.
normal new index :
IF old direction = up
THEN index DECR 1; TRUE
ELSE index INCR 1; TRUE FI.
END PROC new index;
(******************** channel (table) handling *****************************)
BOOL PROC channel free (INT CONST nr,
ROW 256 INT CONST channel table of shard) :
IF nr < 0 OR nr > nr of channels total
THEN FALSE
ELSE channel table of shard [index ccb offset] = 0 FI.
index ccb offset :
2 * nr + 1 + 1.
END PROC channel free;
BOOL PROC channel free (INT CONST nr) :
channel free (nr, channel table of new shard).
END PROC channel free;
PROC reserve channel (INT CONST nr,
ROW 256 INT VAR channel table of shard) :
IF nr >= 0 AND nr < nr of channels total
THEN channel table of shard [index ccb offset] := 1 (* nichtnull *) FI.
index ccb offset :
2 * nr + 1 + 1. (* Start nicht bei 0 und ccb hinter dtcb *)
END PROC reserve channel;
PROC reserve channel (INT CONST nr) :
reserve channel (nr, channel table of new shard).
END PROC reserve channel;
(*THESAURUS PROC free channels (ROW 256 INT VAR channel table of shard):
(* Liefert einen THESAURUS, der die Klartextform genau aller in
channel table of shard als frei angegebenen Kanäle enthält.
*)
INT VAR i;
THESAURUS VAR result :: empty thesaurus;
FOR i FROM 1 UPTO nr of channels total REP
IF channel free (i, channel table of shard)
THEN insert (result, text (i)) FI
PER;
result.
END PROC free channels;*)
INT PROC channels of this module :
channels of module.
END PROC channels of this module;
(********************* write info, buffer adress **************************)
PROC write info :
putline (actual info)
END PROC write info;
INT PROC buffer address (INT CONST buffer size):
IF new shard length MOD 2.0 <> 0.0 THEN new shard length INCR 1.0 FI;
INT CONST buf adr := unsigned (new shard length);
new shard length INCR real (buffer size);
IF new shard length >= 65536.0 OR buffer size > 1024
THEN errorstop ("zu großer Puffer verlangt")
FI;
buf adr
END PROC buffer address;
(************************* Hilfsprozeduren *******************************)
PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line,
INT VAR start module nr, BOOL CONST new init, ins, dump, lst,
sys, coder, rt check, sermon) :
EXTERNAL 256
END PROC elan;
PROC do (TEXT CONST long line) :
DATASPACE VAR ds;
INT VAR module nr :: 0;
elan (2, ds, long line, module nr, FALSE, FALSE, FALSE, FALSE,
FALSE, FALSE, FALSE, FALSE);
forget (ds);
no do again
END PROC do;
PROC go on :
put (" >>>>> Taste drücken zum Weitermachen ");
REPEAT UNTIL incharety (2) = "" PER;
pause;
line.
END PROC go on;
END PACKET setup eumel modulkonfiguration;