1% $Id: test.sim,v 1.2 1994/07/17 10:41:41 cim Exp $
2
3
4% Copyright (C) 1994 Sverre Hvammen Johansen, Stein Krogdahl and Terje Mj�s
5% Department of Informatics, University of Oslo.
6%
7% This program is free software; you can redistribute it and/or modify
8% it under the terms of the GNU General Public License as published by
9% the Free Software Foundation; version 2.
10%
11% This program is distributed in the hope that it will be useful,
12% but WITHOUT ANY WARRANTY; without even the implied warranty of
13% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14% GNU General Public License for more details.
15%
16% You should have received a copy of the GNU General Public License
17% along with this program; if not, write to the Free Software
18% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20SimSet begin class Flink(MaxInstr, MaxIntt, MaxReal); integer MaxInstr, MaxIntt, MaxReal;
21begin real array RStore(0:MaxReal); integer array Func, Adrs, Corr(0:MaxInstr),
22IStore(0:MaxIntt); real R; integer I, C, CF, CA, CC, PC; integer TotalTid;
23procedure DumpRegs; begin OutImage; SetPos( 1); OutText("I = "); OutNum(I);
24SetPos(21); OutText("C = "); OutNum(C); SetPos(41); OutText("PC = "); OutNum(PC); OutImage; SetPos( 1); OutText("CF = "); OutNum(CF); SetPos(21); OutText("CA = "); OutNum(CA);
25SetPos(41); OutText("CC = "); OutNum(CC); OutImage; end DumpRegs; procedure DumpIStore; begin
26integer Inx; OutImage; OutText("IStore:"); for Inx := 0 step 1 until MaxIntt do begin if Mod(Inx,6) = 0 then begin
27OutImage; OutInt(Inx,4); OutText(": "); end; OutInt(IStore(Inx), 11);
28end for; OutImage; end DumpIStore; procedure DumpRStore;
29begin integer Inx; OutImage; OutText("RStore:"); for Inx := 0 step 1 until MaxReal do begin
30if Mod(Inx,5) = 0 then begin OutImage; OutInt(Inx,4); OutText(": "); end;
31OutReal(RStore(Inx), 8, 14); end for; OutImage; end DumpRStore;
32procedure OutNum(N); integer N; begin if N < 0 then begin
33OutChar('-'); OutNum(-N); end else begin if N > 9 then OutNum(N//10); OutChar(Char(Rank('0') + Mod(N,10)));
34end; end OutNum; procedure Run; begin
35integer Tid, FinAddr; switch Instr := STOP, LDI, STI, LDC, STC, ADDI, SUBI, MULI, DIVI, INI, OUTI, OLIN, JMP, JRC, JLTI, JLEI, JEQI, JNEI,
36JGTI, JGEI, SETI, INCI, SETC, INCC, CIC, CCI, LDR, STR, ADDR, SUBR, MULR, DIVR, INR, OUTR, JLTR, JLER, JEQR, JNER, JGER, JGTR, ZROR, CIR, CRI; Tid := 0;
37Next: TotalTid := TotalTid+Tid; Tid := 0; CF := Func(PC); CA := Adrs(PC); CC := Corr(PC); PC := PC+1; FinAddr := CA;
38if CC <> 0 then FinAddr := FinAddr+C; if CF < 0 or CF > 42 then begin OutText("Ulovlig instruksjonskode: "); OutNum(CF); OutImage; goto StopRun;
39end; goto Instr(CF+1); STOP: Tid := 1; goto StopRun; LDI: I := IStore(FinAddr); Tid := 2; goto Next;
40STI: IStore(FinAddr) := I; Tid := 2; goto Next; LDC: C := IStore(FinAddr); Tid := 2; goto Next; STC: IStore(FinAddr) := C; Tid := 2; goto Next; ADDI: I := I + IStore(FinAddr); Tid := 2; goto Next;
41SUBI: I := I - IStore(FinAddr); Tid := 2; goto Next; MULI: I := I * IStore(FinAddr); Tid := 10; goto Next; DIVI: if IStore(FinAddr) = 0 then begin OutImage;
42OutText("Integer division by zero."); OutImage; goto StopRun; end; I := I // IStore(FinAddr); Tid := 15; goto Next;
43INI: OutText("Integer value> "); BreakOutImage; InImage; I := InInt; Tid := 100; goto Next; OUTI: OutInt(I, FinAddr); Tid := 50; goto Next; OLIN: OutImage; Tid := 50; goto Next;
44JMP: PC := FinAddr; Tid := 1; goto Next; JRC: C := PC; PC := FinAddr; Tid := 1; goto Next; JLTI: if I < 0 then PC := FinAddr; Tid := 1; goto Next; JLEI: if I <= 0 then PC := FinAddr; Tid := 1; goto Next;
45JEQI: if I = 0 then PC := FinAddr; Tid := 1; goto Next; JNEI: if I <> 0 then PC := FinAddr; Tid := 1; goto Next; JGTI: if I > 0 then PC := FinAddr; Tid := 1; goto Next; JGEI: if I >= 0 then PC := FinAddr; Tid := 1; goto Next;
46SETI: I := FinAddr; Tid := 1; goto Next; INCI: I := I + FinAddr; Tid := 1; goto Next; SETC: C := FinAddr; Tid := 1; goto Next; INCC: C := C + FinAddr; Tid := 1; goto Next;
47CIC: C := I; Tid := 1; goto Next; CCI: I := C; Tid := 1; goto Next; LDR: R := RStore(FinAddr); Tid := 10; goto Next; STR: RStore(FinAddr) := R; Tid := 10; goto Next;
48ADDR: R := R + RStore(FinAddr); Tid := 10; goto Next; SUBR: R := R - RStore(FinAddr); Tid := 10; goto Next; MULR: R := R * RStore(FinAddr); Tid := 15; goto Next; DIVR: if Rstore(FinAddr) = 0 then begin
49OutImage; OutText("Real division by zero."); OutImage; goto StopRun; end;
50R := R / RStore(FinAddr); Tid := 20; goto Next; INR: OutText("Real value> "); BreakOutImage; InImage; R := InReal; Tid := 150; goto Next; OUTR: OutFix(R, I, FinAddr); Tid := 100; goto Next;
51JLTR: if R < 0 then PC := FinAddr; Tid := 10; goto Next; JLER: if R <= 0 then PC := FinAddr; Tid := 10; goto Next; JEQR: if R = 0 then PC := FinAddr; Tid := 10; goto Next; JNER: if R <> 0 then PC := FinAddr; Tid := 10; goto Next;
52JGER: if R >= 0 then PC := FinAddr; Tid := 10; goto Next; JGTR: if R > 0 then PC := FinAddr; Tid := 10; goto Next; ZROR: R := 0; Tid := 1; goto Next; CIR: R := I; Tid := 20; goto Next;
53CRI: I := R; Tid := 20; goto Next; StopRun: TotalTid := TotalTid+Tid; if CF<>0 or FinAddr<>0 then DumpRegs; end Run;
54 PC := 0; I := 0; C := 0; TotalTid := 0; end Flink; ref(Flink) FM;
55ref(OutFile) ListeFil; integer TestMarg1, TestMarg2; boolean RTestUtskrift,
56FTestUtskrift, NTestUtskrift, STestUtskrift, TTestUtskrift;
57procedure Feil1(T); text T; begin Feil4(T, notext, notext, notext);
58end Feil1; procedure Feil2(T1, T2); text T1, T2; begin
59Feil4(T1, T2, notext, notext); end Feil2; procedure Feil3(T1, T2, T3); text T1, T2, T3;
60begin Feil4(T1, T2, T3, notext); end Feil3; procedure Feil4(T1, T2, T3, T4);
61value T1; text T1, T2, T3, T4; begin Tgen.SkrivLinjen(SysOut);
62UpCase(T1.Sub(1,1)); OutText("*** Feil: "); OutText(T1); OutText(T2); OutText(T3); OutText(T4); OutChar('.'); OutImage; inspect ListeFil do begin
63OutText("*** Feil: "); OutText(T1); OutText(T2); OutText(T3); OutText(T4); OutChar('.'); OutImage; end inspect; goto Avslutt;
64end Feil4; ref(TegnGenerator) Tgen; character NT; class TegnGenerator;
65hidden protected F, LinjeNr, NesteNT, NyttTegn; begin text F; integer LinjeNr;
66character NesteNT; procedure SkrivLinjen(UtF); ref(OutFile) UtF; begin
67end SkrivLinjen; procedure LukkFil; begin comment Lukk filen F. ;
68end LukkFil; procedure NyttTegn(C); character C; begin
69comment Et nytt tegn er klar til } sendes videre til Sgen. --"-- Unng} } sende flere blanke etter hverandre. --"-- Gi testutskrift (om |nsket) og send tegnet. ; if NT=' ' and C=' ' then begin
70comment Unng} } sende lange sekvenser av blanke. Denne blanke b|r --"-- derfor bare ignoreres. ; end else begin if TTestUtskrift then begin
71inspect ListeFil do begin SetPos(TestMarg1); OutText("---T '"); OutChar(C); OutText("' (Rank="); OutInt(Rank(C),3); OutText(")"); OutImage; end inspect;
72end if; NT := C; Detach; end if; end NyttTegn;
73F:-"prog " & " " & " var sil(40); " & " var i,k; " &
74" " & " var stor; " & " " & " " &
75" proc fjern in m; " & " var i; " & " begproc " & " i := 2*m; " &
76" while i<=40 do " & " sil(i) := 0; " & " i := i+m; " & " endwhile; " &
77" endproc; " & " " & "begprog " & " " &
78" " & " stor := 1000000; " & " " & " i := 0; " &
79" while i<=40 do " & " sil(i) := 1; " & " i := i+1; " & " endwhile; " &
80" " & " " & " k := 2; " & " while k<7 do " &
81" call fjern with k; " & " k := k+1; " & " endwhile; " & " " &
82" " & " if sil(2)<>1 then i := sil(stor); endif; " & " if sil(3)<>1 then i := sil(stor); endif; " & " if sil(5)=/=1 then i := sil(stor); endif; " &
83" if sil(7)=/=1 then i := sil(stor); endif; " & " if sil(11)=/=1 then i := sil(stor); endif; " & " if sil(13)=/=1 then i := sil(stor); endif; " & " if sil(17)=/=1 then i := sil(stor); endif; " &
84" if sil(19)=/=1 then i := sil(stor); endif; " & " if sil(23)=/=1 then i := sil(stor); endif; " & " if sil(29)=/=1 then i := sil(stor); endif; " & " if sil(31)=/=1 then i := sil(stor); endif; " &
85" if sil(37)=/=1 then i := sil(stor); endif; " & " " & " if sil(9)=0 then " & " else i := sil(stor); endif; " &
86" if sil(25)=0 then " & " else i := sil(stor); endif; " & " " & " i := 2; " &
87" while i<41 do " & " if sil(i)=1 then outint(4)i; endif; " & " i := i+1; " & " endwhile; " &
88" " & "endprog; "; Detach; while F.More do begin
89NesteNT := F.GetChar; if NesteNT = '-' and F.More then begin NesteNT := F.GetChar; NyttTegn('-'); NyttTegn(NesteNT);
90end else begin NyttTegn(NesteNT); end if; end while;
91Feil1("Slutten av programmet mangler"); end TegnGenerator; Link class Navn(Id, Nr); value Id;
92text Id; integer Nr; begin end Navn;
93ref(Head) NavneTab; integer procedure TallAvNavn(T); text T; begin
94ref(Navn) NP; integer NyttNr; boolean Funnet; NP :- NavneTab.First;
95while NP=/=none and not Funnet do begin if NP.Id = T then Funnet := true else NP :- NP.Suc; end while;
96if Funnet then begin TallAvNavn := NP.Nr; end else begin TallAvNavn := NyttNr := NavneTab.Cardinal+1;
97new Navn(T,NyttNr).Into(NavneTab); if NTestUtskrift then begin inspect ListeFil do begin SetPos(TestMarg1); OutText("---N Nytt navn (nr."); OutInt(NyttNr,4);
98OutText("): "); OutText(T); OutImage; end inspect; end if; end inspect;
99end TallAvNavn; text procedure NavnAvTall(N); integer N; begin
100ref(Navn) NP; boolean Funnet; NP :- NavneTab.First; while NP=/=none and not Funnet do begin
101if NP.Nr = N then Funnet := true else NP :- NP.Suc; end while; NavnAvTall :- Copy(if NP == none then "???" else NP.Id);
102end NavnAvTall; boolean procedure ErNokkelord(N); integer N; begin
103ErNokkelord := N <= Hwith; end ErNokkelord; Link class Deklarasjon(Navn, Adresse); integer Navn, Adresse;
104begin end Deklarasjon; Deklarasjon class VarDeklarasjon;; Deklarasjon class VektorDeklarasjon;;
105Deklarasjon class ProsedyreDeklarasjon; begin boolean HarInnParam, HarUtparam; end ProsedyreDeklarasjon;
106ref(Head) LokalDeklListe, GlobalDeklListe; boolean ErIProsedyre; ref(Deklarasjon) procedure LetIDeklListe(Liste, Id); ref(Head) Liste;
107integer Id; begin comment Let i angitt deklarasjons-liste etter Id. ; ref(Deklarasjon) D;
108boolean Funnet; D :- Liste.First; while D=/=none and not Funnet do begin if D.Navn = Id then Funnet := true
109else D :- D.Suc; end while; LetIDeklListe :- D; end LetIDeklListe;
110procedure NyDeklarasjon(D); ref(Deklarasjon) D; begin comment Sett en ny deklarasjon inn i tabellen i riktig liste. ;
111ref(Head) Liste; Liste :- if ErIProsedyre then LokalDeklListe else GlobalDeklListe; if LetIDeklListe(Liste,D.Navn) =/= none then Feil2(NavnAvTall(D.Navn), " er allerede deklarert");
112D.Into(Liste); end NyDeklarasjon; ref(Deklarasjon) procedure FinnDeklarasjon(Id); integer Id;
113begin ref(Deklarasjon) Dekl; if ErIProsedyre then Dekl :- LetIDeklListe(LokalDeklListe, Id); if Dekl == none then Dekl :- LetIDeklListe(GlobalDeklListe, Id);
114if Dekl == none then Feil2(NavnAvTall(Id), " er ikke deklarert"); FinnDeklarasjon :- Dekl; end FinnDeklarasjon; procedure InnIProsedyre;
115begin if ErIProsedyre then Feil1("Det er ulovlig } deklarere en prosedyre inne i en annen"); ErIProsedyre := true;
116end InnIProsedyre; procedure UtAvProsedyre; begin LokalDeklListe.Clear; ErIProsedyre := false;
117end UtAvProsedyre; ref(SymbolGenerator) Sgen; integer HS, BS; integer Hbegproc, Hbegprog, Hcall, Hdo, Helse, Hendif, Hendproc, Hendprog,
118Hendwhile, Hif, Hin, Hinint, Hinto, Hout, Houtint, Houtline, Hproc, Hprog, Hthen, Hvar, Hwhile, Hwith, Hnavn, Hkonst, Haritop, Hsammenlign, Hvenstrepar, Hhoyrepar, Hkomma, Hsemikolon, Htilordn; integer Bpluss, Bminus, Bganger, Bdivisjon, Bmindre, Bmindrelik, Blik, Bulik,
119Bstorre, Bstorrelik; class SymbolGenerator; hidden protected DetteSy, NyttSy; begin
120text DetteSy; procedure NyttSy(H, B, Sy); text Sy; integer H, B;
121begin comment Et nytt symbol er klart. Lag test-utskrift (om |nsket), --"-- og send symbolet videre til Fgen. ; if STestUtskrift then begin
122inspect ListeFil do begin SetPos(TestMarg1); OutText("---S "); OutInt(H,3); OutInt(B,11); SetPos(Pos+2); OutText(Sy); OutImage; end inspect;
123end if; HS := H; BS := B; Detach; end NyttSy; procedure LesNavn;
124begin comment Leser et navn (som ogs} kan v{re et reservert ord). ; text Id; integer IdNum;
125Id :- Blanks(80); while Letter(NT) or Digit(NT) do begin Id.PutChar(NT); Call(Tgen); end while;
126Id :- UpCase(Id.Strip); IdNum := TallAvNavn(Id); if ErNokkelord(IdNum) then NyttSy(IdNum,0,Id) else NyttSy(Hnavn,IdNum,Id);
127end LesNavn; procedure LesKonstant; begin comment Leser en numerisk konstant. ;
128text Buf; Buf :- Blanks(9); while Digit(NT) do begin if not Buf.More then
129Feil3("Numerisk konstant `", Buf, "..' er for stor"); Buf.PutChar(NT); Call(Tgen); end while; NyttSy(Hkonst,Buf.GetInt,Buf);
130end LesKontant; Detach; Call(Tgen); while true do begin
131while NT = ' ' do Call(Tgen); if Letter(NT) then LesNavn else if Digit(NT) then LesKonstant else if NT = '+' then begin NyttSy(Haritop,Bpluss,"+"); Call(Tgen) end else
132if NT = '-' then begin NyttSy(Haritop,Bminus,"-"); Call(Tgen) end else if NT = '*' then begin NyttSy(Haritop,Bganger,"*"); Call(Tgen) end else if NT = '/' then begin NyttSy(Haritop,Bdivisjon,"/"); Call(Tgen) end else if NT = '(' then begin NyttSy(Hvenstrepar,0,"("); Call(Tgen) end else
133if NT = ')' then begin NyttSy(Hhoyrepar,0,")"); Call(Tgen) end else if NT = ',' then begin NyttSy(Hkomma,0,","); Call(Tgen) end else if NT = ';' then begin NyttSy(Hsemikolon,0,";"); Call(Tgen) end else if NT = '<' then begin
134Call(Tgen); if NT = '=' then begin NyttSy(Hsammenlign,Bmindrelik,"<="); Call(Tgen); end else
135if NT = '>' then begin NyttSy(Hsammenlign,Bulik,"<>"); Call(Tgen); end else NyttSy(Hsammenlign,Bmindre,"<"); end else
136if NT = '=' then begin Call(Tgen); if NT = '/' then begin Call(Tgen);
137if NT = '=' then begin NyttSy(Hsammenlign,Bulik,"<>"); Call(Tgen); end else Feil3("Ulovlig tegn-kombinasjon: `=/", TextAvChar(NT), "'"); end else NyttSy(Hsammenlign,Blik,"=");
138end else if NT = '>' then begin Call(Tgen); if NT = '=' then begin
139NyttSy(Hsammenlign,Bstorrelik,">="); Call(Tgen); end else NyttSy(Hsammenlign,Bstorre,">"); end else if NT = ':' then begin
140Call(Tgen); if NT = '=' then begin NyttSy(Htilordn,0,":="); Call(Tgen); end else Feil3("Ulovlig tegn-kombinasjon: `:", TextAvChar(NT), "'");
141end else Feil3("Ulovlig tegn: `", TextAvChar(NT), "'"); end while; end SymbolGenerator; class VarInfo(Adresse);
142integer Adresse; begin comment Klasse (brukt av Fgen) for } lagre informasjon om en variabel- --"-- forekomst i Minila-programmet. Foruten variabelens Adresse
143--"-- lagres f|lgende opplysninger: --"-- Indeksert: `true' hvis variabelen var indeksert (f.eks. `A(I)'), --"-- `false' hvis kun en vanlig variabel (f.eks. `B'). --"-- VarIndeks: `true' hvis indeksen var en variabel (som i `A(I)'),
144--"-- `false' hvis indeksen var en konstant (som i `A(5)'). --"-- IndeksAdr: Indeks-variabelens adresse --"-- (kun aktuelt hvis Indeksert & VarIndeks). --"-- IndeksVerdi: Indeks-konstantens verdi
145--"-- (kun aktuelt hvis Indeksert & not Varindeks). ; integer IndeksAdr, IndeksVerdi; boolean Indeksert, VarIndeks; end VarInfo;
146ref(FlinkGenerator) Fgen; class FlinkGenerator; hidden protected Synlig; begin
147boolean Synlig; text array InstrNavn(0:25); integer array AritOpKode(1:4), BetOpKode(1:6);
148integer NesteInstr, NesteInt, ProcNivaa, TempUttrykk,
149TempBetingelse; integer Istop, Ildi, Isti, Ildc, Istc, Iaddi, Isubi, Imuli, Idivi, Iini, Iouti, Iolin, Ijmp, Ijrc, Ijlti, Ijlei, Ijeqi, Ijnei, Ijgti, Ijgei, Iseti, Iinci, Isetc, Iincc, Icic, Icci;
150procedure TestProc1(ProcId); text ProcId; begin comment Programmet er g}tt inn i en ny analyse-prosedyre.
151--"-- Gi en passende testutskrift. ; integer I; inspect ListeFil do begin SetPos(TestMarg1); OutText("---R ");
152for I := 1 step 1 until ProcNivaa do OutText(" "); OutText("Start "); OutText(ProcId); OutImage; end inspect; ProcNivaa := ProcNivaa+1;
153end TestProc1; procedure TestProc2(ProcId); text ProcId; begin
154comment Programmet er g}tt ut av en analyse-prosedyre. --"-- Gi en passende testutskrift. ; integer I; ProcNivaa := ProcNivaa-1;
155inspect ListeFil do begin SetPos(TestMarg1); OutText("---R "); for I := 1 step 1 until ProcNivaa do OutText(" "); OutText("Slutt "); OutText(ProcId); OutImage;
156end inspect; end TestProc2; procedure LagInstr(FK, AK, CK); integer FK, AK, CK;
157begin comment Genererer en Flink-instruksjon. ; if NesteInstr > FM.MaxInstr then Feil2("Programmet er for langt, ",
158"det er ikke nok plass i Flinks's instruksjonslager"); inspect FM do begin Func(NesteInstr) := FK; Adrs(NesteInstr) := AK; Corr(NesteInstr) := CK; end inspect;
159if FTestUtskrift then begin inspect ListeFil do begin SetPos(TestMarg2); OutText("---F"); OutInt(NesteInstr,14); OutText(": "); OutText(InstrNavn(FK));
160SetPos(TestMarg2+24); OutInt(AK,12); IF CK=1 then OutText(" *"); OutImage; end inspect; end if;
161NesteInstr := NesteInstr+1; end LagInstr; procedure LagHentVar(VI); ref(VarInfo) VI;
162begin comment Lager kode for } hente variabelen VI inn i I-reg. ; if VI.Indeksert then begin if VI.VarIndeks then LagInstr(Ildc, VI.IndeksAdr, 0)
163else LagInstr(Isetc, VI.IndeksVerdi, 0); end if; LagInstr(Ildi, VI.Adresse, if VI.Indeksert then 1 else 0); end LagHentVar;
164procedure LagSettVar(VI); ref(VarInfo) VI; begin comment Lager kode for } sette verdien i I-reg ned i variabelen VI. ;
165if VI.Indeksert then begin if VI.VarIndeks then LagInstr(Ildc, VI.IndeksAdr, 0) else LagInstr(Isetc, VI.IndeksVerdi, 0); end if;
166LagInstr(Isti, VI.Adresse, if VI.Indeksert then 1 else 0); end LagSettVar; procedure FyllGammelAdr(Lok, NyAdr); integer Lok, NyAdr;
167begin comment Opdater adresse-delen av den tidligere genererte instruksjonen --"-- i lokasjonen Lok til } v{re NyAdr. ; FM.Adrs(Lok) := NyAdr;
168if FTestUtskrift then begin inspect ListeFil do begin SetPos(TestMarg2); OutText("---F"); OutInt(Lok,14); OutText(">>>"); OutInt(NyAdr,15); OutImage;
169end inspect; end if; end FyllGammelAdr; integer procedure SettAvKonstant(Verdi);
170integer Verdi; begin comment Sett inn en ny konstant i Flink's heltallslager. --"-- Returner den nye konstantens adresse. ;
171if NesteInt > FM.MaxIntt then Feil1("Ikke mer plass i Flink's heltallslager"); if FTestUtskrift then begin inspect ListeFil do begin
172SetPos(TestMarg2); OutText("---F K"); OutInt(NesteInt,11); OutText(": "); OutInt(Verdi,16); OutImage; end inspect; end if;
173FM.IStore(NesteInt) := Verdi; SettAvKonstant := NesteInt; NesteInt := NesteInt+1; end SettAvKonstant; integer procedure SettAvVariabel(Id);
174integer Id; begin comment Sett av plass i Flink's heltallslager til en ny variabel. --"-- Returner den nye variabelens adresse. ;
175if NesteInt > FM.MaxIntt then Feil1("Ikke mer plass i Flink's heltallslager"); if FTestUtskrift then begin inspect ListeFil do begin
176SetPos(TestMarg2); OutText("---F V"); OutInt(NesteInt,11); OutText(": "); OutText(NavnAvTall(Id)); OutImage; end inspect; end if;
177SettAvVariabel := NesteInt; NesteInt := NesteInt+1; end SettAvVariabel; integer procedure SettAvVektor(AntElem, Id); integer AntElem, Id;
178begin comment Sett av plass i Flink's heltallslager til en ny vektor. --"-- Returner den nye vektorens start-adresse. ; if NesteInt+AntElem > FM.MaxIntt+1 then
179Feil1("Ikke mer plass i Flink's heltallslager"); if FTestUtskrift then begin inspect ListeFil do begin SetPos(TestMarg2); OutText("---F A"); OutInt(NesteInt,5);
180OutChar('-'); OutInt(NesteInt+AntElem-1,5); OutText(": "); OutText(NavnAvTall(Id)); OutImage; end inspect; end if;
181SettAvVektor := NesteInt; NesteInt := NesteInt+AntElem; end SettAvVektor; procedure Forvent(Sy); integer Sy;
182begin comment Forvent } finne symbolet Sy. Hvis HS <> Sy, --"-- kall feil-prosedyren. ; if HS <> Sy then begin
183Feil4("Det skulle kommet ", TextAvSymbol(Sy), " n}, ikke ", TextAvSymbol(HS)); end if; end Forvent;
184procedure LesBetingelse(TestAdresse); name TestAdresse; integer TestAdresse; begin
185comment Les en betingelse. Adressen til den instruksjonen som hopper --"-- hvis betingelsen var gal (= `false'), returneres i TestAdresse. ; integer BetOp; if RTestUtskrift then TestProc1("Betingelse");
186LesUttrykk; Forvent(Hsammenlign); BetOp := BS; LagInstr(Isti, TempBetingelse, 0); Call(Sgen); LesUttrykk; LagInstr(Isubi, TempBetingelse, 0);
187TestAdresse := NesteInstr; LagInstr(BetOpKode(BetOp), -1, 0); if RTestUtskrift then TestProc2("Betingelse"); end LesBetingelse; procedure LesCallSetning;
188begin ref(VarInfo) VIP; if RTestUtskrift then TestProc1("CallSetning"); Call(Sgen); Forvent(Hnavn);
189inspect FinnDeklarasjon(BS) when ProsedyreDeklarasjon do begin Call(Sgen); if HarInnParam then begin Forvent(Hwith); Call(Sgen); LesUttrykk;
190end if; LagInstr(Ijrc, Adresse, 0); if HarUtParam then begin Forvent(Hinto); Call(Sgen); LagSettVar(LesVariabel);
191end if; end otherwise Feil2(NavnAvTall(BS), " er ikke en prosedyre"); if RTestUtskrift then TestProc2("CallSetning"); end LesCallSetning;
192procedure LesDeklListe(Termin); integer Termin; begin comment Les en liste av deklarasjoner terminert av symbolet Termin. ;
193if RTestUtskrift then TestProc1("DeklListe"); while HS <> Termin do begin if HS = Hvar then LesVarDekl else if HS = Hproc then LesProcDekl else
194Feil2("En deklarasjon m} starte med VAR eller PROC, ikke ", TextAvSymbol(HS)); Forvent(Hsemikolon); Call(Sgen); end while;
195if RTestUtskrift then TestProc2("DeklListe"); end LesDeklListe; procedure LesIfSetning; begin
196integer TestAdresse, ElseAdresse; if RTestUtskrift then TestProc1("IfSetning"); Call(Sgen); LesBetingelse(TestAdresse); Forvent(Hthen); Call(Sgen); LesSetnListe(Helse, Hendif);
197if HS = Helse then begin ElseAdresse := NesteInstr; LagInstr(Ijmp, -1, 0); FyllGammelAdr(TestAdresse, NesteInstr); Call(Sgen); LesSetnListe(Hendif, -1);
198FyllGammelAdr(ElseAdresse, NesteInstr); end else begin FyllGammelAdr(TestAdresse, NesteInstr); end if;
199Call(Sgen); if RTestUtskrift then TestProc2("IfSetning"); end LesIfSetning; procedure LesOutintSetning;
200begin integer Bredde; if RTestUtskrift then TestProc1("OutintSetning"); Call(Sgen); Forvent(Hvenstrepar);
201Call(Sgen); Forvent(Hkonst); Bredde := BS; Call(Sgen); Forvent(Hhoyrepar); Call(Sgen); LesUttrykk; LagInstr(Iouti, Bredde, 0); if RTestUtskrift then TestProc2("OutintSetning");
202end LesOutintSetning; procedure LesOutlineSetning; begin if RTestUtskrift then TestProc1("OutlineSetning");
203LagInstr(Iolin, 0, 0); Call(Sgen); if RTestUtskrift then TestProc2("OutlineSetning"); end LesOutlineSetning; procedure LesProcDekl;
204begin ref(ProsedyreDeklarasjon) PD; integer PDnavn; integer InnParamAdr, UtParamAdr, ReturAdrAdr;
205if RTestUtskrift then TestProc1("ProcDekl"); Call(Sgen); Forvent(Hnavn); PDnavn:=bs; PD :- new ProsedyreDeklarasjon(PDnavn, NesteInstr); NyDeklarasjon(PD); ReturAdrAdr := SettAvVariabel(PDnavn);
206InnIProsedyre; Call(Sgen); if HS<>Hin and HS<>Hout and HS<>Hsemikolon then Feil2("Her kan det st} IN, OUT eller `;', ikke ", TextAvSymbol(HS));
207if HS = Hin then begin Call(Sgen); Forvent(Hnavn); PD.HarInnParam := true; InnParamAdr := SettAvVariabel(BS); NyDeklarasjon(new VarDeklarasjon(BS,InnParamAdr));
208Call(Sgen); end if; if HS<>Hout and HS<>Hsemikolon then Feil2("Her kan det st} OUT eller `;', ikke ", TextAvSymbol(HS));
209if HS = Hout then begin Call(Sgen); Forvent(Hnavn); PD.HarUtParam := true; UtParamAdr := SettAvVariabel(BS); NyDeklarasjon(new VarDeklarasjon(BS,UtParamAdr));
210Call(Sgen); end if; LagInstr(Istc, ReturAdrAdr, 0); if PD.HarInnParam then LagInstr(Isti, InnParamAdr, 0);
211Forvent(Hsemikolon); Call(Sgen); LesDeklListe(Hbegproc); Call(Sgen); LesSetnListe(Hendproc,-1); Call(Sgen); if PD.HarUtParam then LagInstr(Ildi, UtParamAdr, 0); LagInstr(Ildc, ReturAdrAdr, 0);
212LagInstr(Ijmp, 0, 1); UtAvProsedyre; if RTestUtskrift then TestProc2("ProcDekl"); end LesProcDekl;
213procedure LesProgram; begin if RTestUtskrift then TestProc1("Program"); LagInstr(Ijmp, -1, 0);
214Forvent(Hprog); Call(Sgen); LesDeklListe(Hbegprog); FyllGammelAdr(0, NesteInstr); Call(Sgen); LesSetnListe(Hendprog,-1); LagInstr(Istop, 0, 0);
215if RTestUtskrift then TestProc2("Program"); end LesProgram; procedure LesSetnListe(Termin1, Termin2); integer Termin1, Termin2;
216begin comment Les en setningsliste som avsluttes av ett av de to terminator- --"-- symbolene Termin1 eller Termin2. (Hvis listen kun har ett --"-- terminator-symbol, kan den andre parameteren settes til -1.) ;
217if RTestUtskrift then TestProc1("SetnListe"); while HS<>Termin1 and HS<>Termin2 do begin if HS = Hcall then LesCallSetning else if HS = Hif then LesIfSetning else
218if HS = Houtint then LesOutintSetning else if HS = Houtline then LesOutlineSetning else if HS = Hwhile then LesWhileSetning else if HS = Hnavn then LesTilordning else
219Feil2("En setning kan ikke starte med ", TextAvSymbol(HS)); Forvent(Hsemikolon); Call(Sgen); end while; if RTestUtskrift then TestProc2("SetnListe");
220end LesSetnListe; procedure LesTilordning; begin ref(VarInfo) VenstreSide;
221if RTestUtskrift then TestProc1("Tilordning"); VenstreSide :- LesVariabel; Forvent(Htilordn); Call(Sgen); LesUttrykk; LagSettVar(VenstreSide); if RTestUtskrift then TestProc2("Tilordning");
222end LesTilordning; procedure LesUttrykk; begin procedure LesOperand1;
223begin comment Leser f|rste (og muligens eneste) operand i et uttrykk. ; if HS = Hnavn then begin LagHentVar(LesVariabel);
224end else if HS = Hkonst then begin LagInstr(Iseti, BS, 0); Call(Sgen); end else
225if HS = Hinint then begin LagInstr(Iini, 0, 0); Call(Sgen); end else Feil2(TextAvSymbol(HS), " kan ikke brukes som operand i uttrykk");
226end LesOperand1; procedure LesOperand2(Opp); integer Opp; begin
227comment Leser andre operand til operatoren Op. ; ref(VarInfo) VI; if HS = Hnavn then begin VI :- LesVariabel;
228if VI.Indeksert then begin if VI.VarIndeks then LagInstr(Ildc, VI.IndeksAdr, 0) else LagInstr(Isetc, VI.IndeksVerdi, 0); end if;
229LagInstr(AritOpKode(Opp), VI.Adresse, if VI.Indeksert then 1 else 0); end else if HS = Hkonst then begin LagInstr(AritOpKode(Opp), SettAvKonstant(BS), 0);
230Call(Sgen); end else if HS = Hinint then begin LagInstr(Icic, 0, 0); LagInstr(Iini, 0, 0);
231LagInstr(Isti, TempUttrykk, 0); LagInstr(Icci, 0, 0); LagInstr(AritOpKode(Opp), TempUttrykk, 0); Call(Sgen); end else
232Feil2(TextAvSymbol(HS), " kan ikke brukes som operand i uttrykk"); end LesOperand2; integer OpNum; if RTestUtskrift then Testproc1("Uttrykk");
233LesOperand1; while HS = Haritop do begin OpNum := BS; Call(Sgen); LesOperand2(OpNum); end while;
234if RTestUtskrift then Testproc2("Uttrykk"); end LesUttrykk; procedure LesVarDekl; begin
235procedure LesNyVar; begin comment Les en ny variabel i en variabel-deklarasjon. ; integer VarId, MaxElem;
236Forvent(Hnavn); VarId := BS; Call(Sgen); if HS = Hvenstrepar then begin Call(Sgen); Forvent(Hkonst); MaxElem := BS; NyDeklarasjon(new VektorDeklarasjon(VarId,
237SettAvVektor(MaxElem+1,VarId))); Call(Sgen); Forvent(Hhoyrepar); Call(Sgen); end else begin NyDeklarasjon(new VarDeklarasjon(VarId,SettAvVariabel(VarId)));
238end; end LesNyVar; if RTestUtskrift then TestProc1("VarDekl"); Call(Sgen); LesNyVar;
239while HS = Hkomma do begin Call(Sgen); LesNyVar; end while; if RTestUtskrift then TestProc2("VarDekl");
240end LesVarDekl; ref(VarInfo) procedure LesVariabel; begin comment Leser en <Variabel>, men lager ingen kode. ;
241ref(Deklarasjon) VD, ID; ref(VarInfo) VI; if RTestUtskrift then TestProc1("Variabel"); Forvent(Hnavn); VD :- FinnDeklarasjon(BS);
242if VD is ProsedyreDeklarasjon then Feil2(NavnAvTall(VD.Navn), " er en prosedyre, ikke en variabel"); LesVariabel :- VI :- new VarInfo(VD.Adresse); Call(Sgen);
243if HS = Hvenstrepar then begin if VD is VarDeklarasjon then Feil2(NavnAvTall(VD.Navn), " er en vanlig variabel, og kan ikke indekseres");
244VI.Indeksert := true; Call(Sgen); if HS = Hnavn then begin ID :- FinnDeklarasjon(BS); if not(ID is VarDeklarasjon) then
245Feil2("En indeks m} v{re en vanlig variabel; det er ikke ", NavnAvTall(ID.Navn)); VI.VarIndeks := true; VI.IndeksAdr := ID.Adresse; end else
246if HS = Hkonst then begin VI.IndeksVerdi := BS; end else Feil2("En indeks m} v{re et navn eller en konstant, ikke ",
247TextAvSymbol(HS)); Call(Sgen); Forvent(Hhoyrepar); Call(Sgen); end else begin if VD is VektorDeklarasjon then
248Feil2(NavnAvTall(VD.Navn), " er en vektor, og skulle v{rt indeksert"); end if; if RTestUtskrift then TestProc2("Variabel"); end LesVariabel;
249procedure LesWhileSetning; begin integer WhileStart, TestAdresse; if RTestUtskrift then TestProc1("WhileSetning");
250WhileStart := NesteInstr; Call(Sgen); LesBetingelse(TestAdresse); Forvent(Hdo); Call(Sgen); LesSetnListe(Hendwhile, -1); Call(Sgen); LagInstr(Ijmp, WhileStart, 0);
251FyllGammelAdr(TestAdresse, NesteInstr);  if RTestUtskrift then TestProc2("WhileSetning"); end LesWhileSetning;
252begin procedure DefInstr(Id, Instr, InstrKode); name Instr; text Id;
253integer Instr, InstrKode; begin comment Definer en ny Flink-instruksjon. ; Instr := InstrKode; InstrNavn(InstrKode) :- Id;
254end DefInstr; integer X; boolean GammelNTest; GammelNTest := NTestUtskrift;
255NTestUtskrift := false; TempUttrykk := SettAvKonstant(0); TempBetingelse := SettAvKonstant(0); DefInstr("STOP", Istop, 0); DefInstr("LDI", Ildi, 1);
256DefInstr("STI", Isti, 2); DefInstr("LDC", Ildc, 3); DefInstr("STC", Istc, 4); DefInstr("ADDI", Iaddi, 5); DefInstr("SUBI", Isubi, 6); DefInstr("MULI", Imuli, 7); DefInstr("DIVI", Idivi, 8); DefInstr("INI", Iini, 9);
257DefInstr("OUTI", Iouti, 10); DefInstr("OLIN", Iolin, 11); DefInstr("JMP", Ijmp, 12); DefInstr("JRC", Ijrc, 13); DefInstr("JLTI", Ijlti, 14); DefInstr("JLEI", Ijlei, 15); DefInstr("JEQI", Ijeqi, 16); DefInstr("JNEI", Ijnei, 17);
258DefInstr("JGTI", Ijgti, 18); DefInstr("JGEI", Ijgei, 19); DefInstr("SETI", Iseti, 20); DefInstr("INCI", Iinci, 21); DefInstr("SETC", Isetc, 22); DefInstr("INCC", Iincc, 23); DefInstr("CIC", Icic, 24); DefInstr("CCI", Icci, 25);
259AritOpKode(Bpluss) := Iaddi; AritOpKode(Bminus) := Isubi; AritOpKode(Bganger) := Imuli; AritOpKode(Bdivisjon) := Idivi; BetOpKode(Bmindre) := Ijlei; BetOpKode(Bmindrelik) := Ijlti; BetOpKode(Blik) := Ijnei; BetOpKode(Bulik) := Ijeqi;
260BetOpKode(Bstorre) := Ijgei; BetOpKode(Bstorrelik) := Ijgti; NTestUtskrift := GammelNTest; end Initialisering; Detach;
261Call(Sgen); LesProgram; end FlinkGenerator; text procedure TextAvChar(C); character C;
262begin comment Lag en text av lengde 1 som inneholder C. ; text T; TextAvChar :- T :- Blanks(1); T.PutChar(C);
263end TextAvChar; text procedure TextAvSymbol(S); integer S; begin
264comment Lag en tekstlig representasjon av symbolet S. ; if S=Hnavn then TextAvSymbol :- "et navn" else if S=Hkonst then TextAvSymbol :- "en tall-konstant" else if S=Haritop then TextAvSymbol :- "en aritmetisk operator" else
265if S=Hsammenlign then TextAvSymbol :- "en sammenligningsoperator" else if S=Hvenstrepar then TextAvSymbol :- "`('" else if S=Hhoyrepar then TextAvSymbol :- "`)'" else if S=Hkomma then TextAvSymbol :- "`,'" else
266if S=Hsemikolon then TextAvSymbol :- "`;'" else if S=Htilordn then TextAvSymbol :- "`:='" else TextAvSymbol :- NavnAvTall(S); end TextAvSymbol;
267begin character C; FM :- new Flink(400,400,1); NavneTab :- new Head;
268LokalDeklListe :- new Head; GlobalDeklListe :- new Head; Hbegproc := TallAvNavn("BEGPROC"); Hbegprog := TallAvNavn("BEGPROG"); Hcall := TallAvNavn("CALL"); Hdo := TallAvNavn("DO"); Helse := TallAvNavn("ELSE"); Hendif := TallAvNavn("ENDIF");
269Hendproc := TallAvNavn("ENDPROC"); Hendprog := TallAvNavn("ENDPROG"); Hendwhile := TallAvNavn("ENDWHILE"); Hif := TallAvNavn("IF"); Hin := TallAvNavn("IN"); Hinint := TallAvNavn("ININT"); Hinto := TallAvNavn("INTO"); Hout := TallAvNavn("OUT");
270Houtint := TallAvNavn("OUTINT"); Houtline := TallAvNavn("OUTLINE"); Hproc := TallAvNavn("PROC"); Hprog := TallAvNavn("PROG"); Hthen := TallAvNavn("THEN"); Hvar := TallAvNavn("VAR"); Hwhile := TallAvNavn("WHILE"); Hwith := TallAvNavn("WITH");
271Hnavn := 23; Hkonst := 24; Haritop := 25; Hsammenlign := 26;
272Hvenstrepar := 27; Hhoyrepar := 28; Hkomma := 29; Hsemikolon := 30; Htilordn := 31; Bpluss := 1; Bminus := 2; Bganger := 3; Bdivisjon := 4;
273Bmindre := 1; Bmindrelik := 2; Blik := 3; Bulik := 4; Bstorre := 5; Bstorrelik := 6; TestMarg1 := 12; TestMarg2 := 32; Tgen :- new TegnGenerator;
274Sgen :- new SymbolGenerator; Fgen :- new FlinkGenerator; end initiering; Call(Fgen);
275begin character C; FM.Run; end;
276goto avslutt; error: sysout.image:=""; Avslutt:
277Tgen.LukkFil; inspect ListeFil do Close; if sysout.image.strip="   2   3   5   7  11  13  17  19  23  29  31  37" then begin
278sysout.image:=""; sysout.setpos(1); Outtext("Installation: No errors found"); outimage; return(0);
279end else begin sysout.image:=""; sysout.setpos(1);
280Outtext("*** Installation: Errors found ***"); outimage; return(1); end; end program
281%eof
282