1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
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
91
92
93
94
95
96
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
PACKET knotenDEFINES systembaum,setzesystembaumundaktuellenknoten,
generierebaisymonitor,KNOTEN ,STACK ,KNOTENMENGE ,leeremenge,nilknoten,
leererstack,anfangsknotenholen,einzelknotenholen,erster,weitere,naechster,
attribute,maske,task,text,nummer,vorprozedur,nachprozedur,taste,isrefinement,
isopen,knotenaufrufindex,HAT ,zahlderelemente,mengedernachfolger,:=,=,push,
pop,hoehe,voll,leer:LET maxhoehe=20,bottom=1;LET maxkn=2190;TYPE LONGROW =
TEXT ;TYPE KNOTENMENGE =INT ;TYPE KNOTEN =STRUCT (INT zeile,index);TYPE
INTKNOTEN =INT ;TYPE EINTRAG =STRUCT (TEXT attribute,INTKNOTEN vater,LONGROW
knotenmengenLONGROW knoten);TYPE SYSTAB =STRUCT (INT maxeintrag,ersterfreier,
ROW maxknEINTRAG zeile);KNOTEN CONST nilknoten:=KNOTEN :(0,0);BOUND SYSTAB
VAR sysbaum;TYPE STACK =STRUCT (ROW maxhoeheKNOTEN st,INT top);LET maxat=6,
tepos=1,mpos=2,vpos=3,npos=4,tpos=5,ppos=6;LET scanid=1;DATASPACE VAR ds;
BOOL VAR verteilteraufruf;INT VAR newkind;TEXT VAR newsymbol;TEXT VAR
pruefstack;BOOL PROC isid:(newkind=scanid)END PROC isid;PROC next:nextsymbol(
newsymbol,newkind);END PROC next;PROC next(TEXT CONST proz):scan(proz);next
END PROC next;BOOL PROC prozedurexistiert(TEXT CONST prozname):BOOL VAR da:=
false;scanstring(da,prozname);da.END PROC prozedurexistiert;PROC scanstring(
BOOL VAR da,TEXT CONST str):procpos:=1;next(str);analyse(da);WHILE NOT
schlussREP next(subtext(str,procpos+4));IF isidTHEN analyse(da)ELSE da:=false
FI ;procposINCR 1PER .schluss:INT VAR procpos:=pos(str,"PROC",procpos);
procpos=0.END PROC scanstring;PROC analyse(BOOL VAR da):IF schongeprueftTHEN
da:=trueELSE da:=analyseergebnis(newsymbol);IF daTHEN alsgeprueftvermerkenFI
FI .schongeprueft:pos(pruefstack,pruefname(newsymbol))>0.alsgeprueftvermerken
:pruefstackCAT pruefname(newsymbol).END PROC analyse;BOOL PROC
analyseergebnis(TEXT CONST prozname):pruefungvorbereiten;IF iserrorTHEN
breakabfangen;falseELSE trueFI .pruefungvorbereiten:disablestop;type("�q");
help(prozname).breakabfangen:TEXT VAR br:="";editget(br);clearerror.END PROC
analyseergebnis;TEXT PROC pruefname(TEXT CONST name):"/"+name+"/"END PROC
pruefname;TEXT PROC prozedur(TEXT CONST pname):IF pname<>""THEN IF
prozedurexistiert(pname)THEN pnameELSE "return(1)"FI ELSE pnameFI END PROC
prozedur;PROC generierebaisymonitor(TEXT CONST teilbaumname):LET maxcase=510;
startemonitordatei;naechstezeile;WHILE NOT tabellenendeREP neuescase;
naechstezeilePER ;schlusszeilen.startemonitordatei:richtedateiein;
anfangszeile.richtedateiein:TEXT CONST monitorname:=teilbaumname+" monitor";
forget(monitorname,quiet);FILE VAR f:=sequentialfile(output,monitorname).
anfangszeile:putline(f,
"PACKET baisymonitor DEFINES call,starten ueber monitor:");TEXT VAR anfaenge
:="";INT VAR tabind:=0;INT VAR caseproczahl:=0;INT VAR aktcasezahl:=0;INT
VAR maxtabeintrag:=sysbaum.ersterfreier-1;pruefstack:="".naechstezeile:
aktcasezahlINCR 1;tabindINCR 1;cout(tabind).tabellenende:tabind>maxtabeintrag
.neuescase:IF aktcasezahl=1THEN neuecaseprocFI ;casewennnoetig;IF aktcasezahl
=maxcaseTHEN schlusscaseprocFI .neuecaseproc:caseproczahlINCR 1;putline(f,
"PROC case"+text(caseproczahl)+"(INT CONST i,BOOL CONST vor):");putline(f,
"SELECT i OF").casewennnoetig:IF gueltigezeileTHEN KNOTEN VAR k;k.zeile:=
tabind;TEXT VAR vproc:=prozedur(vorprozedur(k));IF vproc<>""THEN vprocteil;
TEXT VAR nproc:=prozedur(nachprozedur(k));IF nproc<>""THEN nprocteilELSE put(
f,"FI");line(f)FI FI FI .gueltigezeile:CONCR (sysbaum.zeile(tabind).vater)>=0
.vprocteil:put(f,"CASE "+text(aktcasezahl)+": ");put(f,"IF vor THEN "+vproc).
nprocteil:put(f," ELSE "+nproc+" FI");line(f).schlusszeilen:schlusscaseproc;
procanfang;ifabfragen;procundpacketende.schlusscaseproc:putline(f,
"END SELECT");putline(f,"END PROC case"+text(caseproczahl)+";");aktcasezahl:=
0;anfaengeCAT text(tabind,4).procanfang:putline(f,"PROC call"+
"(INT CONST i,BOOL CONST vor,TEXT CONST t):").ifabfragen:INT VAR ifzahl:=
caseproczahl-1;IF ifzahl=0THEN einfacherfallELIF ifzahl=1THEN erstesif;
elseteilELSE erstesif;alleelifs;elseteilFI .caseaufruf:TEXT VAR zusatz:="";
TEXT VAR decr:=subtext(anfaenge,basis-3,basis);IF decr<>""THEN zusatz:=" - "+
decrFI ;put(f,"case"+text(aktcaseindex)+"(i"+zusatz+",vor)");.einfacherfall:
put(f,"case1(i,vor)");line(f).erstesif:INT VAR aktcaseindex;basis:=0;put(f,
"IF i<="+subtext(anfaenge,1,4)+" THEN");einfacherfall.alleelifs:INT VAR elif;
FOR elifFROM 1UPTO ifzahl-1REP neueselifPER .neueselif:put(f,"ELIF ");
aktcaseindex:=elif+1;INT VAR basis:=elif*4;put(f,"i <="+subtext(anfaenge,
basis+1,basis+4)+" THEN");caseaufruf;line(f).elseteil:put(f,"ELSE ");basis
INCR 4;aktcaseindex:=ifzahl+1;caseaufruf;putline(f," FI").procundpacketende:
putline(f,"END PROC call;");putline(f,"PROC starten ueber monitor:");putline(
f,"start baisy("""+teilbaumname+
""",PROC (INT CONST,BOOL CONST,TEXT CONST) call)");putline(f,
"END PROC starten ueber monitor");putline(f,"END PACKET baisymonitor");
pruefstack:="".END PROC generierebaisymonitor;DATASPACE PROC systembaum:ds
END PROC systembaum;KNOTEN VAR aktuellerknoten;PROC
setzesystembaumundaktuellenknoten(DATASPACE CONST d,INT CONST s):ds:=d;
aktuellerknoten.zeile:=sEND PROC setzesystembaumundaktuellenknoten;PROC
kopplesystembauman(TEXT CONST name):forget(ds);ladesystembaum(ds,name);
sysbaum:=dsEND PROC kopplesystembauman;PROC anfangsknotenholen(TEXT CONST
name,KNOTEN VAR k,BOOL VAR ok):schaltersetzen;vglkn:=nilknoten;IF NOT
verteilteraufrufTHEN kopplesystembauman(name);suche(k,ok)ELSE ok:=TRUE ;
sysbaum:=ds;k:=aktuellerknotenFI .schaltersetzen:verteilteraufruf:=name="".
END PROC anfangsknotenholen;PROC einzelknotenholen(TEXT CONST name,KNOTEN
VAR einzelknoten,BOOL VAR ok):IF NOT verteilteraufrufTHEN
holeindexvoneinzelknoten;IF okTHEN vermerkeihnanletzterstelleFI ELSE
sucheunterdenangehaengtenindizesFI .holeindexvoneinzelknoten:DATASPACE VAR
savespace:=ds;kopplesystembauman(name);INT VAR index;suche(index,ok);forget(
ds);ds:=savespace;forget(savespace);sysbaum:=ds.vermerkeihnanletzterstelle:
einzelknoten.zeile:=index;sysbaum.maxeintragINCR 1;CONCR (sysbaum.zeile(
sysbaum.maxeintrag).vater):=einzelknoten.zeile;sysbaum.zeile(sysbaum.
maxeintrag).attribute:=taste(einzelknoten).sucheunterdenangehaengtenindizes:
INT VAR i;FOR iFROM sysbaum.ersterfreierUPTO sysbaum.maxeintragREP IF sysbaum
.zeile(i).attribute=nameTHEN einzelknoten.zeile:=CONCR (sysbaum.zeile(i).
vater)FI PER .END PROC einzelknotenholen;PROC suche(KNOTEN VAR k,BOOL VAR ok)
:suche(k.zeile,ok);sysbaum.maxeintragINCR 1;sysbaum.ersterfreier:=sysbaum.
maxeintrag;CONCR (sysbaum.zeile(sysbaum.maxeintrag).vater):=k.zeileEND PROC
suche;PROC suche(INT VAR k,BOOL VAR ok):k:=CONCR (sysbaum.zeile(sysbaum.
ersterfreier).vater);ok:=(k>0)END PROC suche;KNOTENMENGE PROC leeremenge:
KNOTENMENGE :(0)END PROC leeremenge;STACK PROC leererstack:STACK VAR s;s.top
:=bottom;sEND PROC leererstack;TEXT PROC knotentexte(KNOTEN CONST k):sysbaum.
zeile(k.zeile).attributeEND PROC knotentexte;PROC knotentexte(KNOTEN VAR k,
TEXT CONST t):sysbaum.zeile(k.zeile).attribute:=tEND PROC knotentexte;TEXT
PROC maske(KNOTEN CONST k):attribut(k,mpos)END PROC maske;TEXT PROC task(
KNOTEN CONST k):attribut(k,ppos)END PROC task;INT PROC nummer(KNOTEN CONST k)
:knotenaufrufindex(k)END PROC nummer;TEXT PROC text(KNOTEN CONST k):attribut(
k,tepos)END PROC text;TEXT PROC vorprozedur(KNOTEN CONST k):attribut(k,vpos)
END PROC vorprozedur;TEXT PROC nachprozedur(KNOTEN CONST k):attribut(k,npos)
END PROC nachprozedur;TEXT PROC taste(KNOTEN CONST k):attribut(k,tpos)END
PROC taste;TEXT VAR attext;TEXT PROC attribut(KNOTEN CONST k,INT CONST i):
attribute(k);TEXT VAR amuster:="��",emuster:="��";replace(amuster,1,i);
replace(emuster,1,i+1);INT VAR ende,anfang;anfang:=pos(attext,amuster)+2;IF i
<maxatTHEN ende:=pos(attext,emuster,anfang)-1;subtext(attext,anfang,ende)
ELSE subtext(attext,anfang)FI END PROC attribut;KNOTEN VAR vglkn;PROC
attribute(KNOTEN CONST k):IF NOT (k=vglkn)THEN attext:=knotentexte(k);vglkn:=
kFI END PROC attribute;BOOL PROC isrefinement(KNOTEN CONST k):attribute(k);(
attextSUB 1)="1"END PROC isrefinement;BOOL PROC isnormal(KNOTEN CONST k):
attribute(k);(attextSUB 1)="0"END PROC isnormal;BOOL PROC isopen(KNOTEN
CONST k):NOT (isrefinement(k)COR isnormal(k))END PROC isopen;OP HAT (KNOTEN
VAR k,TEXT CONST t):knotentexte(k,t)END OP HAT ;INT PROC zahlderelemente(
KNOTENMENGE CONST m):length(sysbaum.zeile(CONCR (m)).knoten)END PROC
zahlderelemente;INT PROC length(LONGROW CONST l):length(CONCR (l))DIV 2END
PROC length;PROC mengedernachfolger(KNOTEN CONST k,KNOTENMENGE VAR m):CONCR (
m):=k.zeileEND PROC mengedernachfolger;KNOTEN PROC erster(KNOTENMENGE CONST m
):KNOTEN VAR k;aktuellemenge:=sysbaum.zeile(CONCR (m)).knoten;aktuellelaenge
:=length(aktuellemenge);mengenindex:=CONCR (m);k.zeile:=0;k.index:=0;
naechster(k);kEND PROC erster;LONGROW VAR aktuellemenge;INT VAR
aktuellelaenge;INT VAR mengenindex;PROC naechster(KNOTEN VAR k):IF (
aktuellelaenge>0)CAND (k.index<aktuellelaenge)THEN k.indexINCR 1;k.zeile:=
CONCR (aktuellemenge)ISUB k.indexELSE k:=nilknotenFI END PROC naechster;INT
PROC knotenaufrufindex(KNOTEN CONST k):k.zeileEND PROC knotenaufrufindex;
BOOL PROC weitere(KNOTEN CONST k,KNOTENMENGE CONST m):(CONCR (m)=mengenindex)
CAND (k.index<>0)END PROC weitere;BOOL OP =(KNOTEN CONST k,l):k.zeile=l.zeile
END OP =;OP :=(KNOTEN VAR ziel,KNOTEN CONST quelle):CONCR (ziel):=CONCR (
quelle)END OP :=;OP :=(KNOTENMENGE VAR ziel,KNOTENMENGE CONST quelle):CONCR (
ziel):=CONCR (quelle)END OP :=;OP :=(LONGROW VAR ziel,LONGROW CONST quelle):
CONCR (ziel):=CONCR (quelle)END OP :=;OP :=(STACK VAR ziel,STACK CONST quelle
):CONCR (ziel):=CONCR (quelle)END OP :=;PROC push(STACK VAR s,KNOTEN CONST k)
:IF NOT (s.top=maxhoehe)THEN s.st(s.top):=k;s.topINCR 1FI END PROC push;PROC
pop(STACK VAR s,KNOTEN VAR k):IF NOT (s.top=bottom)THEN s.topDECR 1;k:=s.st(s
.top);FI END PROC pop;INT PROC hoehe(STACK CONST s):s.top-1END PROC hoehe;
BOOL PROC voll(STACK CONST s):s.top=maxhoeheEND PROC voll;BOOL PROC leer(
STACK CONST s):s.top=bottomEND PROC leer;END PACKET knoten;
|
