(* ------------------- VERSION 10 vom 01.08.86 -------------------- *)
PACKET referencer errors DEFINES report referencer error:
(* Programm zur Fehlerbehandlung des referencers.
Autor: Rainer Hahn *)
TEXT VAR fehlerdummy,
message;
PROC report referencer error (INT CONST error nr,
INT CONST line nr,
TEXT CONST addition):
einfache fehlermeldung aufbauen;
diese auf terminal ausgeben;
fehlermeldung in fehlerdatei ausgeben.
einfache fehlermeldung aufbauen:
message := "WARNUNG in Zeile ";
message CAT text (line nr);
message CAT " : ";
message CAT simple message.
diese auf terminal ausgeben:
line ;
putline (message).
fehlermeldung in fehlerdatei ausgeben:
note (message);
note line ;
fehlerdummy := " >>> ";
fehlerdummy CAT zusatz;
note (fehlerdummy);
note line.
simple message:
SELECT error nr OF
CASE 1: "Text Denoter ueber mehr als eine Zeile"
CASE 2: "Nicht beendeter Text Denoter bei Programmende"
CASE 3: "Kommentar ueber mehr als eine Zeile"
CASE 4: "Nicht beendeter Kommentar bei Programmende"
CASE 5: "Ueberdeckung"
CASE 6, 9: "Refinement mehrmals eingesetzt"
CASE 7, 10: "Refinement wird nicht aufgerufen"
CASE 8: "Objekt wird nicht angesprochen"
OTHERWISE ""
ENDSELECT.
zusatz:
SELECT error nr OF
CASE 1, 2, 3, 4: "Ueber " + addition + " Zeilen"
CASE 5: addition
CASE 6, 7, 8: addition
CASE 9, 10: addition + " in mindestens einer Prozedur"
OTHERWISE "interner Fehler: HRZ Bielefeld benachrichtigen!"
END SELECT.
END PROC report referencer error
END PACKET referencer errors;
(************************************************************************)
PACKET name table handling
DEFINES NAMETABLE,
empty name table,
put name,
get name,
dump table:
(* Programm zur Speicherung von Namen.
Autor: Rainer Hahn *)
LET hash table length = 1024,
hash table length minus one = 1023,
start of name table = 255,
name table length = 2000;
TYPE NAMETABLE = STRUCT (INT number of entries,
ROW hash table length INT hash table,
ROW name table length INT next,
ROW name table length TEXT name table);
TEXT VAR dummy, f;
PROC put name (NAMETABLE VAR n, TEXT CONST name, INT VAR pointer):
INT VAR errechneter index;
hash (name, errechneter index);
IF noch kein eintrag
THEN gaenzlich neuer eintrag
ELSE name in vorhandener kette
FI.
noch kein eintrag:
n . hash table [errechneter index] = 0.
gaenzlich neuer eintrag:
n . hash table [errechneter index] := n . number of entries;
neuer eintrag (n, name, pointer).
name in vorhandener kette:
INT VAR dieser eintrag :: n. hash table [errechneter index];
REP
IF name ist vorhanden
THEN pointer := dieser eintrag;
LEAVE put name
ELIF kette zu ende
THEN neuer eintrag an vorhandene kette anketten;
neuer eintrag (n, name, pointer);
LEAVE put name
ELSE naechster eintrag in der kette
FI
END REP.
name ist vorhanden:
n . name table [dieser eintrag] = name.
kette zu ende:
n . next [dieser eintrag] = 0.
neuer eintrag an vorhandene kette anketten:
n . next [dieser eintrag] := n . number of entries.
naechster eintrag in der kette:
dieser eintrag := n . next [dieser eintrag].
END PROC put name;
PROC neuer eintrag (NAMETABLE VAR n, TEXT CONST name, INT VAR pointer):
n . name table [n . number of entries] := name;
n . next [n . number of entries] := 0;
pointer := n . number of entries;
n . number of entries INCR 1;
IF n . number of entries > name table length
THEN errorstop ("volle Namenstabelle")
FI
END PROC neuer eintrag;
PROC hash (TEXT CONST name, INT VAR index) :
INT VAR i;
index := code (name SUB 1);
FOR i FROM 2 UPTO length (name) REP
addmult cyclic
ENDREP.
addmult cyclic :
index INCR index ;
IF index > hash table length minus one
THEN wrap around
FI;
index := (index + code (name SUB i)) MOD hash table length.
wrap around :
index DECR hash table length minus one
ENDPROC hash ;
PROC get name (NAMETABLE CONST n, INT CONST index, TEXT VAR t):
IF index < n . number of entries AND index >= start of name table
THEN t := n . name table [index]
ELSE errorstop ("Interner Fehler 1")
FI
END PROC get name;
PROC empty name table (NAMETABLE VAR n):
INT VAR i;
n . number of entries := start of name table;
FOR i FROM 1 UPTO hash table length REP
n . hash table [i] := 0
END REP
END PROC empty name table;
PROC dump table (NAMETABLE CONST n):
line ;
put ("Bitte Name der Datei, in die die Namenstabelle gehen soll:");
getline (f);
line ;
file assoziieren;
dump namens ketten;
zusammenfassung.
file assoziieren:
FILE VAR file :: sequential file (output, f).
dump namens ketten:
INT VAR i,
anz hash eintraege :: 0,
kette 3 eintraege :: 0;
FOR i FROM 1 UPTO hash table length REP
IF n . hash table [i] <> 0
THEN anz hash eintraege INCR 1;
INT VAR naechster eintrag :: n . hash table [i];
dump hash eintrag;
ketten eintraege
FI
END REP.
dump hash eintrag:
dummy := text (i);
WHILE length (dummy) < 4 REP dummy CAT " " END REP;
dummy CAT ": ".
ketten eintraege:
INT VAR anz eintraege pro kette :: 0;
WHILE naechster eintrag > 0 REP
anz eintraege pro kette INCR 1;
dummy CAT " ";
dummy CAT text (naechster eintrag);
dummy CAT " -> ";
dummy CAT n . name table [naechster eintrag];
naechster eintrag := n . next [naechster eintrag];
END REP;
IF anz eintraege pro kette > 2
THEN kette 3 eintraege INCR 1
FI;
putline (file, dummy).
zusammenfassung:
statistik ueberschrift;
anzahl hash eintraege;
anzahl namens eintraege;
verkettungsfaktor;
anzahl laengerer ketten.
statistik ueberschrift:
line (file, 2);
dummy := " ---------- ";
dummy CAT "S T A T I S T I K:";
dummy CAT " ---------- ";
putline (file, dummy);
line (file, 2).
anzahl hash eintraege:
dummy := "Anzahl Hash-Eintraege (max. ";
dummy CAT text (hash table length);
dummy CAT "): ";
dummy CAT text (anz hash eintraege);
putline (file, dummy).
anzahl namens eintraege:
dummy := "Anzahl Namen (max. ";
dummy CAT text (name table length - start of name table + 1);
dummy CAT "): ";
dummy CAT text (n . number of entries - start of name table);
putline (file, dummy).
verkettungsfaktor:
dummy := "Verkettungsfaktor (Anzahl Namen / Anzahl Ketten): ";
dummy CAT text (real (n . number of entries - start of name table) /
real (anz hash eintraege));
putline (file, dummy).
anzahl laengerer ketten:
dummy := "Anzahl Ketten > 2 Eintraege: ";
dummy CAT text (kette 3 eintraege);
putline (file, dummy).
END PROC dump table;
END PACKET name table handling;
(***************************************************************************)
PACKET scanner DEFINES init scanning,
init name table with,
dump name table,
get name,
end scanning,
line number,
symbol:
(* Programm zum scannen von ELAN-Programmen.
Autor: Rainer Hahn *)
FILE VAR eingabe;
DATASPACE VAR ds alt := nilspace,
ds neu := nilspace;
BOUND NAMETABLE VAR tabelle;
TEXT VAR zeile,
zeichen,
dummy;
LET end of program = ""30"",
eop = 1,
identifier = 2,
keyword = 3,
delimiter = 4,
punkt = 46,
doppelpunkt = 58,
init symbol = 30,
assign symbol = 31;
INT VAR zeilen nr,
zeichen pos;
PROC init name table with (TEXT CONST worte):
INT VAR index;
forget (ds alt);
ds alt := nilspace;
tabelle := dsalt;
empty name table (CONCR (tabelle));
INT VAR anf :: 1,
ende :: pos (worte, ",", 1);
WHILE ende > 0 REP
dummy := subtext (worte, anf, ende - 1);
put name (CONCR (tabelle), dummy, index);
anf := ende + 1;
ende := pos (worte, ",", ende + 1)
END REP;
dummy := subtext (worte, anf);
put name (CONCR (tabelle), dummy, index)
END PROC init name table with;
PROC init scanning (TEXT CONST f):
IF exists (f)
THEN namenstabelle holen;
erste zeile lesen
ELSE errorstop ("Datei existiert nicht")
FI.
namenstabelle holen:
forget (ds neu);
ds neu := ds alt;
tabelle := ds neu.
erste zeile lesen:
eingabe := sequential file (input, f);
IF eof (eingabe)
THEN errorstop ("Datei ist leer")
ELSE zeile := "";
zeilen nr := 0;
zeile lesen;
naechstes non blank zeichen
FI
END PROC init scanning;
PROC dump name table:
dump table (CONCR (tabelle))
END PROC dump name table;
PROC end scanning (TEXT CONST f):
IF anything noted
THEN eingabe := sequential file (modify, f);
note edit (eingabe)
FI
END PROC end scanning;
PROC get name (INT CONST index, TEXT VAR t):
get name (CONCR (tabelle), index, t)
END PROC get name;
PROC zeile lesen:
getline (eingabe, zeile);
zeilen nr INCR 1;
cout (zeilen nr);
zeichen pos := 0
END PROC zeile lesen;
PROC naechstes non blank zeichen:
REP
zeichen pos := pos (zeile, ""33"", ""254"", zeichen pos + 1);
IF zeichen pos <> 0
THEN zeichen := (zeile SUB zeichen pos);
LEAVE naechstes non blank zeichen
ELIF eof (eingabe)
THEN zeichen := end of program;
LEAVE naechstes non blank zeichen
ELSE zeile lesen
FI
END REP.
END PROC naechstes non blank zeichen;
PROC naechstes zeichen:
IF zeichen pos > length (zeile)
THEN IF eof (eingabe)
THEN zeichen := end of program;
LEAVE naechstes zeichen
ELSE zeile lesen
FI
FI;
zeichenpos INCR 1;
zeichen := zeile SUB zeichenpos
END PROC naechstes zeichen;
INT PROC line number:
IF zeichenpos = pos (zeile, ""33"", ""254"", 1)
THEN zeilen nr - 1
ELSE zeilen nr
FI
END PROC line number;
PROC symbol (INT VAR symb, type):
REP
suche naechstes checker symbol
END REP.
suche naechstes checker symbol:
SELECT code (zeichen) OF
CASE 30: (* end of programn *)
symb := eop;
type := eop;
LEAVE symbol
CASE 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110,
111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122:
(* small letters *)
identifier aufsammeln;
put name (CONCR (tabelle), dummy, symb);
type := identifier;
LEAVE symbol
CASE 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81,
82, 83, 84, 85, 86, 87, 88, 89, 90: (* large letters *)
schluesselwort aufsammeln;
put name (CONCR (tabelle), dummy, symb);
type := keyword;
LEAVE symbol
CASE 34: (* " *)
skip text denoter
CASE 40: (* ( *)
IF (zeile SUB zeichen pos + 1) = "*"
THEN skip comment
ELSE symb := code (zeichen);
type := delimiter;
naechstes non blank zeichen;
LEAVE symbol;
FI
CASE 58: (* : *)
IF (zeile SUB zeichenpos + 1) = "="
THEN symb := assign symbol;
zeichenpos INCR 1
ELIF (zeile SUB zeichenpos + 1) = ":"
THEN symb := init symbol;
zeichenpos INCR 1
ELSE symb := doppelpunkt
FI;
type := delimiter;
naechstes non blank zeichen;
LEAVE symbol
CASE 48, 49, 50, 51, 52, 53, 54, 55, 56, 57: (* 0 - 9 *)
int denoter skippen;
IF zeichen = "."
THEN naechstes non blank zeichen;
IF digit
THEN real denoter skippen
ELSE symb := punkt;
type := delimiter;
LEAVE symbol
FI
FI
CASE 41, 44, 46, 59, 61: (* ) , . ; = *)
symb := code (zeichen);
type := delimiter;
naechstes non blank zeichen;
LEAVE symbol
OTHERWISE naechstes non blank zeichen
END SELECT.
END PROC symbol;
PROC real denoter skippen:
int denoter skippen;
IF zeichen = "e"
THEN naechstes non blank zeichen;
int denoter skippen
FI
END PROC real denoter skippen;
PROC int denoter skippen:
naechstes non blank zeichen;
WHILE zeichen >= "0" AND zeichen <= "9" REP
naechstes non blank zeichen
ENDREP;
zeichenpos DECR 1;
naechstes non blank zeichen
END PROC int denoter skippen;
PROC identifier aufsammeln:
dummy := zeichen;
REP
naechstes non blank zeichen;
IF small letter or digit
THEN dummy CAT zeichen
ELSE LEAVE identifier aufsammeln
FI
END REP
END PROC identifier aufsammeln;
PROC schluesselwort aufsammeln:
dummy := "";
sammle schluesselwort;
IF dummy = "END"
THEN noch einmal
FI.
sammle schluesselwort:
WHILE large letter REP
dummy CAT zeichen;
naechstes zeichen
END REP;
IF zeichen = " "
THEN naechstes non blank zeichen
FI.
noch einmal:
sammle schluesselwort
END PROC schluesselwort aufsammeln;
PROC skip text denoter:
INT VAR anz zeilen :: 0;
zeichen pos := pos (zeile, """", zeichenpos + 1);
WHILE zeichen pos = 0 REP
naechste zeile einlesen;
zeichen pos := pos (zeile, """");
END REP;
ende text denoter.
ende text denoter:
IF anz zeilen > 1
THEN report referencer error (1, zeilen nr, text (anz zeilen))
FI;
naechstes non blank zeichen.
naechste zeile einlesen:
IF eof (eingabe)
THEN report referencer error (2, zeilen nr, text (anz zeilen));
zeichen := end of program;
LEAVE skip text denoter
ELSE zeile lesen;
anz zeilen INCR 1
FI.
END PROC skip text denoter;
PROC skip comment:
INT VAR anz zeilen :: 0;
zeichen pos := pos (zeile, "*)", zeichenpos + 2);
WHILE zeichen pos = 0 REP
naechste zeile einlesen;
zeichen pos := pos (zeile, "*)");
END REP;
ende comment.
ende comment:
IF anz zeilen > 1
THEN report referencer error (3, zeilen nr, text (anz zeilen))
FI;
zeichen pos INCR 2;
naechstes non blank zeichen.
naechste zeile einlesen:
IF eof (eingabe)
THEN report referencer error (4, zeilen nr, text (anz zeilen));
zeichen := end of program;
LEAVE skip comment
ELSE zeile lesen;
anz zeilen INCR 1
FI.
END PROC skip comment;
BOOL PROC small letter or digit:
(zeichen >= "0" AND zeichen <= "9") OR (zeichen >= "a" AND zeichen <= "z")
END PROC small letter or digit;
BOOL PROC small letter:
zeichen >= "a" AND zeichen <= "z"
END PROC small letter;
BOOL PROC large letter:
zeichen >= "A" AND zeichen <= "Z"
END PROC large letter;
BOOL PROC digit:
zeichen >= "0" AND zeichen <= "9"
END PROC digit;
END PACKET scanner;
(*************************************************************************)
PACKET referencer2 DEFINES referencer:
(* Programm fuer den 'referencer'
Autor: Rainer Hahn *)
INT VAR symb,
typ,
max index;
TEXT VAR dummy,
dummy2,
name;
DATASPACE VAR ds;
BOUND ROW max TEXT VAR liste;
FILE VAR f;
BOOL VAR initialisiert :: FALSE,
symbol bereits geholt,
globale deklarationen;
LET max = 1751,
global text = "<--G",
local text = "<--L",
refinement text = "<--R",
procedure text = "<--P",
eop = 1,
identifier = 2,
keyword = 3,
init symbol = 30,
assign symbol = 31,
klammer auf = 40,
klammer zu = 41,
komma = 44,
punkt = 46,
doppelpunkt = 58,
semikolon = 59,
proc symbol = 255,
end proc symbol = 256,
packet symbol = 257,
end packet symbol = 258,
type symbol = 259,
var symbol = 260,
const symbol = 261,
let symbol = 262,
leave symbol = 263,
op symbol = 264,
endop symbol = 265,
endif symbol = 266,
fi symbol = 266;
PROC referencer:
referencer (last param)
END PROC referencer;
PROC referencer (TEXT CONST check file):
referencer (check file, check file + ".r")
END PROC referencer;
PROC referencer (TEXT CONST check file, dump file):
IF exists (check file)
THEN dump file ggf loeschen
ELSE errorstop ("Eingabe-Datei nicht vorhanden")
FI;
disable stop;
start referencing (check file, dump file);
forget (ds);
enable stop.
dump file ggf loeschen:
IF exists (dump file)
THEN forget (dump file, quiet)
FI.
END PROC referencer;
PROC start referencing (TEXT CONST check file, dump file):
enable stop;
ueberschrift;
initialisierung;
verkuerzte syntax analyse;
line ;
in dump file kopieren (dump file);
line ;
end scanning (check file).
ueberschrift:
page;
put ("REFERENCER:");
put (check file);
put ("->");
putline (dump file).
initialisierung:
IF NOT initialisiert
THEN init name table with
("PROC,ENDPROC,PACKET,ENDPACKET,TYPE,VAR,CONST,LET,LEAVE,OP,ENDOP,ENDIF,FI");
initialisiert := TRUE
FI;
ds := nilspace;
liste := ds;
max index := end op symbol;
dummy := checkfile.
verkuerzte syntax analyse:
globale deklarationen := TRUE;
line ;
init scanning (dummy);
symbol bereits geholt := FALSE;
REP
IF symbol bereits geholt
THEN symbol bereits geholt := FALSE
ELSE symbol (symb, typ)
FI;
IF typ = keyword
THEN nach schluesselwort verarbeiten
ELIF symb = punkt
THEN ggf refinement aufnehmen
ELIF typ = identifier
THEN identifier aufnehmen und ggf aktuelle parameter liste
FI
UNTIL typ = eop ENDREP.
identifier aufnehmen und ggf aktuelle parameter liste:
in die liste (symb, "");
symbol (symb, typ);
IF symb = klammer auf
THEN aktuelle parameter aufnehmen
ELSE symbol bereits geholt := TRUE
FI.
nach schluesselwort verarbeiten:
SELECT symb OF
CASE let symbol:
let deklarationen aufsammeln
CASE packet symbol:
namen des interface aufsammeln
CASE end packet symbol:
skip naechstes symbol
CASE var symbol, const symbol:
datenobjekt deklaration aufnehmen
CASE proc symbol:
globale deklarationen := FALSE;
prozedur name und ggf parameter aufsammeln
CASE end proc symbol:
globale deklarationen := TRUE;
skip naechstes symbol
CASE op symbol:
globale deklarationen := FALSE;
operatornamen skippen und ggf parameter aufsammeln
CASE end op symbol:
globale deklarationen := TRUE;
skip until (semikolon)
CASE type symbol:
namen der typ definition aufsammeln
CASE leave symbol:
skip naechstes symbol
OTHERWISE:
ENDSELECT.
skip naechstes symbol:
symbol (symb, typ).
END PROC start referencing;
PROC aktuelle parameter aufnehmen:
REP
symbol (symb, typ);
IF typ = identifier
THEN in die liste (symb, "")
FI
UNTIL symb = klammer zu END REP.
END PROC aktuelle parameter aufnehmen;
PROC ggf refinement aufnehmen:
symbol (symb, typ);
symbol bereits geholt := TRUE;
WHILE typ = identifier REP
doppelpunkt oder selektor
END REP.
doppelpunkt oder selektor:
INT CONST letzter id :: symb;
symbol (symb, typ);
IF symb = doppelpunkt
THEN in die liste (letzter id, refinement text);
LEAVE ggf refinement aufnehmen
ELSE in die liste (letzter id, "");
IF symb = punkt
THEN symbol (symb, typ)
ELSE LEAVE ggf refinement aufnehmen
FI
FI
END PROC ggf refinement aufnehmen;
PROC namen des interface aufsammeln:
packet name ueberspringen;
namen der schnittstelle aufsammeln.
packet name ueberspringen:
symbol (symb, typ).
namen der schnittstelle aufsammeln:
REP
symbol (symb, typ);
IF typ = identifier
THEN in die liste (symb, "")
FI
UNTIL symb = doppelpunkt END REP.
END PROC namen des interface aufsammeln;
PROC let deklarationen aufsammeln:
REP
symbol (symb, typ);
IF typ = identifier
THEN let name aufnehmen
ELIF typ = keyword
THEN bis zum komma oder semikolon
FI;
UNTIL symb = semikolon END REP.
let name aufnehmen:
IF globale deklarationen
THEN in die liste (symb, global text)
ELSE in die liste (symb, "")
FI;
REP
symbol (symb, typ);
IF typ = identifier
THEN in die liste (symb, "")
FI
UNTIL symb = komma OR symb = semikolon END REP.
END PROC let deklarationen aufsammeln;
PROC namen der typ definition aufsammeln:
REP
symbol (symb, typ);
bis zum komma oder semikolon
UNTIL symb = semikolon END REP
END PROC namen der typ definition aufsammeln;
PROC bis zum komma oder semikolon:
INT VAR anz klammern :: 0;
REP
symbol (symb, typ); (* fields aufnehmen weggelassen *)
IF symb = klammer auf
THEN anz klammern INCR 1
ELIF symb = klammer zu
THEN anz klammern DECR 1
FI
UNTIL (symb = komma AND anz klammern = 0) OR symb = semikolon ENDREP.
END PROC bis zum komma oder semikolon;
PROC datenobjekt deklaration aufnehmen:
symbol (symb, typ);
REP
IF globale deklarationen
THEN in die liste (symb, global text)
ELSE in die liste (symb, local text)
FI;
skip ggf initialisierung;
IF symb = komma
THEN symbol (symb, typ)
FI
UNTIL symb = semikolon OR symb = punkt END REP.
skip ggf initialisierung:
symbol (symb, typ);
IF symb = init symbol OR symb = assign symbol
THEN initialisierung skippen
FI.
initialisierung skippen:
INT VAR anz klammern :: 0;
REP
INT CONST vorheriges symbol :: symb,
vorheriger typ :: typ;
symbol (symb, typ);
IF symb = klammer auf
THEN anz klammern INCR 1;
IF vorheriger typ = identifier
THEN in die liste (vorheriges symbol, "")
FI
ELIF symb = klammer zu
THEN anz klammern DECR 1;
IF vorheriger typ = identifier
THEN in die liste (vorheriges symbol, "")
FI
ELIF vorheriger typ = identifier AND symb = doppelpunkt
THEN in die liste (vorheriges symbol, refinement text);
LEAVE datenobjekt deklaration aufnehmen
ELIF vorheriger typ = identifier
THEN in die liste (vorheriges symbol, "")
FI
UNTIL (symb = komma AND anz klammern = 0)
OR symb = semikolon OR symb = end proc symbol OR
symb = end op symbol OR symb = endif symbol OR symb = fi symbol
END REP.
END PROC datenobjekt deklaration aufnehmen;
PROC prozedur name und ggf parameter aufsammeln:
prozedurname aufsammeln;
symbol (symb, typ);
IF symb <> doppelpunkt
THEN formale parameter aufsammeln
FI.
prozedurname aufsammeln:
symbol (symb, typ);
in die liste (symb, procedure text).
END PROC prozedurname und ggf parameter aufsammeln;
PROC operatornamen skippen und ggf parameter aufsammeln:
symbol (symb, typ);
IF symb <> doppelpunkt
THEN formale parameter aufsammeln
FI
END PROC operatornamen skippen und ggf parameter aufsammeln;
PROC formale parameter aufsammeln:
REP
symbol (symb, typ);
IF typ = identifier
THEN in die liste (symb, local text);
FI
UNTIL symb = doppelpunkt END REP
END PROC formale parameter aufsammeln;
PROC skip until (INT CONST zeichencode):
skip until (zeichencode, 0)
END PROC skip until;
PROC skip until (INT CONST z1, z2):
REP
symbol (symb, typ)
UNTIL symb = z1 OR symb = z2 END REP
END PROC skip until;
PROC in die liste (INT CONST index, TEXT CONST zusatz):
IF index > max index
THEN listenelemente initialisieren;
FI;
IF aktueller eintrag = ""
THEN namens eintrag
FI;
aktueller eintrag CAT " ";
aktueller eintrag CAT text (line number);
aktueller eintrag CAT zusatz.
aktueller eintrag:
liste [index].
listenelemente initialisieren:
INT VAR i;
FOR i FROM max index + 1 UPTO index REP
liste [i] := ""
END REP;
max index := index.
namens eintrag:
get name (index, aktueller eintrag);
WHILE length (aktueller eintrag) < 15 REP
aktueller eintrag CAT " "
END REP;
aktueller eintrag CAT ":".
END PROC in die liste;
TEXT VAR zeile;
PROC in dump file kopieren (TEXT CONST dump file):
putline ("Ausgabedatei erstellen");
f := sequential file (output, dump file);
INT VAR i;
kopieren und ggf fehlermeldung;
modify (f);
ggf sortieren;
zeile ggf aufspalten;
modify (f);
to line (f, 1).
kopieren und ggf fehlermeldung:
FOR i FROM fi symbol UPTO max index REP
cout (i);
zeile := liste [i];
IF zeile <> ""
THEN ausgabe der referenz und ggf fehlermeldung
FI
ENDREP.
ausgabe der referenz und ggf fehlermeldung:
putline (f, zeile);
ggf referencer fehlermeldung.
ggf sortieren:
IF yes (dump file + " sortieren")
THEN sort (dump file);
FI.
zeile ggf aufspalten:
i := 0;
to line (f, 1);
WHILE NOT eof (f) REP
i INCR 1;
cout (i);
read record (f, zeile);
ggf aufspalten
END REP.
ggf aufspalten:
INT VAR anf :: 1, ende :: pos (zeile, " ", 72);
IF ende > 0
THEN dummy := subtext (zeile, 1, ende - 1);
write record (f, dummy);
spalte bis restzeile auf;
dummy CAT subtext (zeile, anf);
write record (f, dummy);
FI;
down (f).
spalte bis restzeile auf:
REP
dummy := " ";
anf := ende + 1;
ende := pos (zeile, " ", ende + 55);
down (f);
insert record (f);
IF ende <= 0
THEN LEAVE spalte bis restzeile auf
FI;
dummy CAT subtext (zeile, anf, ende - 1);
write record (f, dummy);
END REP.
END PROC in dump file kopieren;
PROC ggf referencer fehlermeldung:
name := subtext (zeile, 1, min( pos(zeile, " "), pos(zeile, ":")) - 1);
dummy := subtext (zeile, pos (zeile, ": ") + 2);
ueberdeckungs ueberpruefung;
not used ueberpruefung;
IF pos (dummy, "R") > 0
THEN refinement mehr als zweimal verwendet
FI.
ueberdeckungs ueberpruefung:
IF pos (dummy, global text) > 0 AND pos (dummy, local text) > 0
THEN dummy2 := "und Zeile ";
dummy2 CAT text (nr (pos (dummy, local text)));
dummy2 CAT ": ";
dummy2 CAT name;
report referencer error
(5, nr (pos (dummy, global text)), dummy2)
FI.
not used ueberpruefung:
IF pos (dummy, " ") = 0 AND
(pos (dummy, global text) > 0 OR pos (dummy, local text) > 0 OR
pos (dummy, refinement text) > 0)
THEN not used fehlermeldung
FI.
not used fehlermeldung:
report referencer error
(8, nr (length (dummy) - length (local text) + 1), name).
refinement mehr als zweimal verwendet:
INT VAR refinement deklarationen :: 0,
refinement aufrufe :: 0,
anf :: 1;
WHILE pos (dummy,"R", anf) > 0 REP
refinement deklarationen INCR 1;
anf := pos (dummy, "R", anf) + 1
END REP;
anf := 1;
WHILE pos (dummy, " ", anf) > 0 REP
refinement aufrufe INCR 1;
anf := pos (dummy, " ", anf) + 1
END REP;
IF refinement deklarationen = 1
THEN IF refinement aufrufe > 1
THEN report referencer error
(6, nr (pos (dummy, refinement text)), name)
ELIF refinement aufrufe = 0
THEN report referencer error
(7, nr (pos (dummy, refinement text)), name)
FI
ELIF refinement deklarationen > 1
THEN IF 2 * refinement deklarationen - 1 > refinement aufrufe
THEN report referencer error (9, 0, name)
ELIF 2 * refinement deklarationen - 1 < refinement aufrufe
THEN report referencer error (10, 0, name)
FI
FI.
END PROC ggf referencer fehlermeldung;
INT PROC nr (INT CONST ende):
INT VAR von :: ende - 1;
WHILE von > 0 AND ((dummy SUB von) >= "0" AND (dummy SUB von) <= "9") REP
von DECR 1
END REP;
int (subtext (dummy, von + 1, ende - 1))
END PROC nr;
END PACKET referencer2;
(*
REP
referencer ("ref fehler");
edit ("ref fehler.r");
UNTIL no ("nochmal") END REP*)