|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 136704 (0x21600)
Types: Rc489k_TapeFile, TextFile
└─⟦aa55fa693⟧ Bits:30007479 SW8110/1 TAS/SOS/PRIMO Rel 2.3
└─⟦this⟧
(rcmol=algol
scope user rcmol
end)
begin
boolean xref;
integer versionid;
zone zxref(128,1,stderror);
integer field if2,if4,if6,if8;
if2:=2; if4:=4; if6:=6; if8:=8;
for versionid:= 85 01 24, 16 while versionid > 700 000 do;
begin
comment ***************************************************
***************************************************
******* *******
******* rcmol - compiler. *******
******* *******
******* udviklet som eksamensprojekt på *******
******* danmarks tekniske højskole *******
******* foråret 1975 *******
******* af *******
******* lars otto kjær nielsen *******
******* *******
***************************************************
***************************************************
;
<* nye og forandrede faciliteter i rcmol:
release 1:
- listning forsynes med procesrelative adresser ved hver linie
- address(operand) returnerer en reference til foerste halvord i
operanden (og ikke som foer sidste halvord)
- byte-konstanter accepteres op til 4095
release 2:
- compiler kald-options list.yes
release 3:
- creer og reserver arealproces til programareal hvis fp.no
release 4:
- call w0 <operand> accepteres som hop uden returregister
release 5:
- udskriv programtextens navn og short-clock ved oversaettelse
- indsaet short-clock i objektprogram entry
- accepter op til 300 identifikatorer
release 6:
- accepter kommentarer omgivet af (! ) og (!)
- accepter specialkarakterer i strenge
karaktervaerdien angives som et heltal omgivet af (') og (')
- accepter konstanter med specificeret radix og cifre mellem 0 og 9
radix og cifre separeres med (')
- accepter test-statement: !test <no>
der genereres ks-<no> hvis 0 <= <no> < 2048
release 7:
- forbedret error recovery
release 8:
- compiler kald-option xref.yes
- udskriv compiler version ved hver oversaettelse
release 9:
- accepter halt-statement: !halt <no>
der genereres jd-<no> hvis 0 <= <no> <= 1000
- undlad automatisk tilfoejelse af <null>-karakter efter textstreng
- accepter navne i indre blokke, som falder sammen med navne fra ydre blokke
release 10:
- undlad at reservere program-arealet, saa flere kan udfoere samme program
- forbyd !save statement, da arealet ikke mere er reserveret
release 11:
- compiler kald-options list.error
lister alle fejlbehaeftede linier
- compiler kald-option test (.<limit>)
hvis <limit> udelades genereres alle ks-<no> instruktioner
hvis <limit> angives genereres kun ks-<no> hvis <no> < <limit>
- returner result,status efter kald af !save og !get
w0 = result or status
w3 = abs ref program areal navn
- accepter op til 400 identifikatorer
- accepter kun byte konstanter mellem -2048 og 2047
release 12:
- fejl omkring branch rettet
release 13:
- navnetabel udvidet til 500 ingange
release 14:
- fejl rettet omkring addressering af dobbelt registre
- f1+f13 : fa w1 14 -> fa w1 6
- rettet i: rex ::= rexstart register
- shift 1; rettet til shift 1 extract 3
release 15:
- antallet af identifiers udviddet fra 500 til 600
- (idtab1, idtab2, idtab3, idtab4, idtab5)
release 16:
- fejl rettet med hensyn til idholdet af w3 ved entry i et program
- oversat med: "!fp.no;" ; w3 er nu addressen på ens egen process beskrivelse
release xx:
*>
integer zpil,item,idtabpil,curridlimit,fejlpil,stakpil,liniepil,casestakpil;
integer nytilst,linienr,isoværdi,klasse,term,art,type,mode,dyn,
delnavn1,delnavn2,delnavn3,beginniv,endniv,blokdybde,procref;
integer i,j,n,kropniv,wliste,partabpil,prkaldpil,procantal,procnr;
integer recovpoint,gemmode,indhop,textlængde,layoutord,zbase,filnr;
integer hoppil,tom,konstpil1,konstpil2,modedybde,basisref,radix,kodeaddr;
integer hptop,kodeadresse,dynref,vindhop,forudsymbol,maxadresse,kodeudpil;
integer blokstart,autotape,grenpil,grenantal,knudepil,knudeantal,fpplads;
integer testlimit;
integer array hnavne(0:99);
integer array konsttab1,konsttab2(0:200);
integer array hoptab1,hoptab2(1:100);
integer array navnetab1,navnetab2,navnetab3,navnetab4(1:82);
integer array skiltab(40:62);
integer array toskil1,toskil2(1:7);
integer array tilst,aktion(1:8,2:8);
integer array linie(1:134);
integer array fejlstak(1:2,1:50);
integer array proctab(0:256);
integer array idtab1,idtab2,idtab3,idtab4,idtab5(1:600);
integer array att1,att2,att3(1:100);
integer array reladr(1:4);
integer array z(1:1300);
integer array streng(0:45);
integer array dyoptab(1:146);
integer array casestak(1:150);
integer array partab1(1:25);
integer array tail(1:10);
integer array dyopslag(1:32);
integer array gemreladr(2:8);
integer array kodeud(1:2,1:5);
real rpackkonst,rkonst,cpu,time,rkonst1;
real array arr(1:2);
long lpackkonst,hkonst,hkonst1;
integer array field fi;
long array field laf;
zone save(128,1,stderror);
boolean list,errorlist,code,fp,mon,binær,frierkl,afbryd1,afbryd2,afbryd3,
afbryd4,afbryd5,oklinie,objectfile;
boolean array wfri(0:3);
comment *******************************************************
* *
* scanner *
* *
*******************************************************
;
integer procedure næstesymbol;
begin
integer navnepil,symbol,exp,tom,i,j;
integer index;
integer array navn(1:9);
comment *******************************************************
indlæsning af enkeltkarakterer
*******************************************************;
procedure nykarakter;
begin
if isoværdi=10 or isoværdi = 12 then
begin comment *** udskrivning af den 'gamle' linie ***;
if list or (errorlist and -, oklinie) then
begin
write(out,<<ddddd>,kodeaddr,<: :>);
kodeaddr:=2*zpil;
outchar(out,beginniv);
outchar(out,endniv);
write(out,<<ddddd>,linienr,if oklinie then <: :> else <:***:>);
for i:=1 step 1 until liniepil do
outchar(out,linie(i));
outchar(out,isoværdi);
end;
comment *** linienummer tælles op og linie 0-stilles ***;
linienr:=if isoværdi = 10 then linienr+1 else (linienr//100+1)*100;
liniepil:=0;
beginniv:=endniv:=45;
oklinie:=true;
end;
klasse:=readchar(in,isoværdi);
if isoværdi=10 then klasse:=5;
if isoværdi = 12 then klasse:=5;
if isoværdi=32 then klasse:=5;
if isoværdi=95 then klasse:=6;
if isoværdi = 39 then klasse:=8;
if isoværdi=25 then fejl(2040);
if isoværdi<>10 and isoværdi <> 12 then
begin
liniepil:=liniepil+1;
linie(liniepil):=isoværdi;
end;
end;
comment *******************************************************
stakning af leksikale fejl
*******************************************************;
procedure fejl(fejlnr);
value fejlnr;
integer fejlnr;
begin
oklinie:=false;
fejlpil:=fejlpil+1;
fejlstak(1,fejlpil):=fejlnr;
fejlstak(2,fejlpil):=linienr;
if fejlpil=49 then fejl(2040);
if fejlnr=2040 then goto passstop;
for i:=0 while isoværdi<>32 do nykarakter;
nytilst:=1;
goto nycase;
end;
comment *******************************************************
søgning i tabel over dobbeltskilletegn
*******************************************************;
procedure toskilsøg;
begin
i:=1;
for tom:=0 while symbol<>toskil1(i) do
if i>6 then
begin comment *** symbolet fandtes ikke og 1. skilletegn opfattes
derfor som selvstændigt symbol ***;
symbol:=symbol shift (-16);
if symbol<40 or symbol>62 then fejl(2017);
term:=skiltab(symbol) extract 6;
art:=skiltab(symbol) shift (-6);
goto stopscan;
end else i:=i+1;
term:=toskil2(i) extract 6;
art:=toskil2(i) shift (-6);
end;
comment *******************************************************
søgning i tabel over reserverede navne
*******************************************************;
procedure navnesøg(tabelnr);
value tabelnr;
integer tabelnr;
begin comment *** navnets karakterer pakkes i tre ord ***;
delnavn1:=navn(1) shift 8 add navn(2) shift 8 add navn(3);
delnavn2:=navn(4) shift 8 add navn(5) shift 8 add navn(6);
delnavn3:=navn(7) shift 8 add navn(8) shift 8 add navn(9);
if delnavn1=6516589 and (delnavn2=7169390 and delnavn3=7602176)
then
begin comment *** navnet er 'comment' ***;
for tom:=0 while isoværdi<>59 do nykarakter;
nykarakter;
nytilst:=1;
goto nycase;
end;
if tabelnr=1 then
begin comment *** beregning af cirkaadresse i navnetabel ***;
index:=1+(delnavn1-6382435)//24200;
if delnavn1>8021362 or delnavn1<6382692 then
begin
term:=38;
art:=0;
goto udnavnesøg;
end;
end else
begin comment *** indsætelse af cirkaadresse til compilerord i tabel ***;
if delnavn1<6387060 or delnavn1>7628147 then fejl(2022);
index:=75;
end;
comment *** søgning i tabel over reserverede navne ***;
for tom:=0 while delnavn1>navnetab1(index) do index:=index+1;
for tom:=0 while delnavn1<navnetab1(index) do index:=index-1;
if delnavn1<>navnetab1(index) or
(delnavn2<>navnetab2(index) or delnavn3<>navnetab3(index)) then
begin
if tabelnr=2 then fejl(2022);
term:=38;
art:=0;
end else
begin comment *** udpakning af symbolnummer og attributter ***;
term:=navnetab4(index) extract 6;
art:=navnetab4(index) shift (-6);
if term=14 then
begin comment *** navnet er 'begin' ***;
blokdybde:=blokdybde+1;
beginniv:=48+blokdybde;
end;
if term=26 then
begin comment *** navnet er 'end' ***;
endniv:=48+blokdybde;
blokdybde:=blokdybde-1;
if blokdybde<1 then afbryd3:=true;
end;
end;
udnavnesøg: end;
comment *******************************************************
tilstands/aktionskonstruktion til erkendelse af termina-
le symboler.
*******************************************************;
nytilst:=1;
if afbryd5 then fejl(2040);
if afbryd2 then
begin comment *** udskrivning af sidste linie -
der læses ikke mere, men simuleres et punktum ***;
term:=5;
if list and liniepil>0 then
begin
write(out,<<ddddd>,kodeaddr,<: :>);
outchar(out,beginniv);
outchar(out,endniv);
write(out,<<ddddd>,linienr,<: :>);
for i:=1 step 1 until liniepil do outchar(out,linie(i));
liniepil:=0;
end;
goto stopscan;
end;
comment *** opslag i aktionsliste over scanneraktioner ***;
nycase: case aktion(nytilst,klasse) of
begin
begin comment ------------ scanneraktion nr 1 ------------;
radix:=10;
hkonst:=isoværdi-48;
end;
begin comment ------------ scanneraktion nr 2 ------------;
if isoværdi-48 >= radix then fejl(2004);
hkonst:=hkonst*radix+isoværdi-48;
if hkonst<0 then fejl(2030);
end;
begin comment ------------ scanneraktion nr 3 ------------;
if radix <> 10 then fejl(2004);
rkonst:=hkonst;
exp:=0;
end;
begin comment ------------ scanneraktion nr 4 ------------;
exp:=exp+1;
if exp>9 then fejl(2031);
rkonst:=rkonst+(isoværdi-48)/10**exp;
end;
begin comment ------------ scanneraktion nr 5 ------------;
exp:=1;
rkonst:=(isoværdi-48)/10;
end;
begin comment ------------ scanneraktion nr 6 ------------;
for i:=2 step 1 until 9 do navn(i):=0;
navn(1):=isoværdi;
navnepil:=1;
end;
begin comment ------------ scanneraktion nr 7 ------------;
if navnepil<9 then
begin
navnepil:=navnepil+1;
navn(navnepil):=isoværdi;
end;
end;
begin comment ------------ scanneraktion nr 8 ------------;
symbol:=isoværdi;
if isoværdi=34 then
begin
nykarakter;
j:=0;
for tom:=0 while isoværdi<>34 and j<132 do
begin
if isoværdi = 39 then
begin
nykarakter;
hkonst:=0;
for tom:=0 while isoværdi >= 48 and isoværdi <= 57 do
begin
hkonst:=hkonst*10+isoværdi-48;
nykarakter;
end;
if isoværdi <> 39 then fejl(2004);
if hkonst > 255 or hkonst < 0 then fejl(2004);
symbol:=hkonst;
end else symbol:=isoværdi;
streng(j//3):=streng(j//3) shift 8 add symbol;
j:=j+1;
nykarakter;
end;
if j=132 then fejl(2007);
for i:=j step 1 until 132 do streng(i//3):=
streng(i//3) shift 8;
nykarakter;
term:=48;
art:=j;
goto stopscan;
end;
end;
begin comment ------------ scanneraktion nr 9 ------------;
if symbol=33 then
begin
for i:=2 step 1 until 9 do navn(i):=0;
navn(1):=isoværdi;
navnepil:=1;
end else
if symbol<40 or symbol>62 then
begin
fejl(2017);
goto stopscan;
end else
begin
term:=skiltab(symbol) extract 6;
art:=skiltab(symbol) shift (-6);
goto stopscan;
end;
end;
begin comment ------------ scanneraktion nr 10 ------------;
end;
begin comment ------------ scanneraktion nr 11 ------------;
if isoværdi=symbol then
begin
term:=24;
if symbol=43 then art:=8 else art:=1 shift 6 add 8;
nykarakter;
end else fejl(2002);
goto stopscan;
end;
begin comment ------------ scanneraktion nr 12 ------------;
symbol:=symbol shift 8 add isoværdi shift 8;
toskilsøg;
nykarakter;
goto stopscan;
end;
begin comment ------------ scanneraktion nr 13 ------------;
term:=41;
if hkonst>8388607 or hkonst<-8388608 then art:=5 else
if hkonst>2047 or hkonst <-2048 then art:=3 else
art:=1;
goto stopscan;
end;
begin comment ------------ scanneraktion nr 14 ------------;
term:=57;
goto stopscan;
end;
begin comment ------------ scanneraktion nr 15 ------------;
term:=5;
art:=0;
goto stopscan;
end;
begin comment ------------ scanneraktion nr 16 ------------;
if symbol=43 then
begin
term:=24;
art:=2;
end else
begin
term:=4;
art:=0;
end;
goto stopscan;
end;
begin comment ------------ scanneraktion nr 17 ------------;
navnesøg(1);
goto stopscan;
end;
begin comment ------------ scanneraktion nr 18 ------------;
if symbol = 33 and isoværdi = 32 then
begin comment remove comment;
for tom:=0 while isoværdi <> 33 do nykarakter;
nykarakter;
nytilst:=1;
goto nycase;
end;
if symbol < 40 or symbol > 62 then fejl(2017) else
begin
term:=skiltab(symbol) extract 6;
art:=skiltab(symbol) shift (-6) ;
end;
goto stopscan;
end;
begin comment ------------ scanneraktion nr 19 ------------;
navnesøg(2);
goto stopscan;
end;
begin comment ------------ scanneraktion nr 20 ------------;
if radix <> 10 then fejl(2004);
radix:=hkonst;
hkonst:=0;
end;
begin comment ------------ scanneraktion nr 21 ------------;
fejl(2004);
end;
end;
comment *** opslag af ny tilstand ***;
nytilst:=tilst(nytilst,klasse);
nykarakter;
goto nycase;
stopscan: næstesymbol:=term;
afbryd5:=afbryd4;
afbryd4:=afbryd2;
afbryd2:=afbryd1;
if (forudsymbol=26 and term=5) or afbryd3 then afbryd1:=true;
forudsymbol:=term;
end næstesymbol;
comment *********************************************************
* *
* syntaxanalysator *
* *
*********************************************************;
procedure parser(semantik,staksemantik,fejl,stakgrænse,næstesymbol);
comment slr1;
value stakgrænse;
integer stakgrænse;
integer procedure næstesymbol;
procedure semantik,staksemantik,fejl;
begin
integer array syntaksstak(1:stakgrænse);
integer aktion,indeks,instruktion,nr,pr,stakpil,symbol,vindue1,vindue2,glindeks;
boolean recovering;
recovering:=false;
glindeks:=1;
syntaksstak(1):=stakpil:=indeks:=1;
vindue1:=vindue2:=næstesymbol;
løkke: instruktion:=case indeks of (
1232903,1216522,1249340,1200190, 626773,
8192, 135255, 430171, 8192,1527901,
1495136, 512097,1282154,1511532, 626797,
1446001, 970869,1347702, 151671,1085567,
594048, 987266,1560709,1069191, 282761,
348299,1118349, 233614, 479376, 561298,
905364,1134742, 168133,1020103, 725192,
1462473, 69845, 610521,1315035, 217311,
315626, 757996, 528622,1364208, 463091,
1003765, 872695, 446712, 495871,1102086,
332041, 20749, 839962,1167645, 299294,
1184032, 676132, 938277, 50, 135462,
8192, 135482, 233787,1020220,1052989,
1298750, 332111, 577874,1036627,1266004,
1331542, 954713,1151324,1479012,1397094,
1544553, 840043, 545133, 692591, 201073,
1413490, 807293, 708991, 8192, 233857,
8192, 266626,1020292, 332111, 13,
86405, 8192, 135558, 430472, 8192,
44,1429897,1446283, 758160, 725192,
1462473, 70034, 610521, 627092, 8192,
1495446, 12300, 48, 102807, 20888,
86432, 85, 119202, 397735, 70056,
51, 52, 53,1118633,1348010,
1364208, 495871,1102086, 151979, 627120,
8192, 55, 20914, 8192, 135604,
430518, 8192,1429943, 12386, 774585,
8192, 725435, 8192, 627133, 8192,
63,1528255, 12299, 20930, 8192,
20932, 8192, 20934, 8192,1511880,
1446001, 970869,1347702, 151671,1085567,
594048, 987266,1560709,1069191, 282761,
348299,1118349, 233614, 479376, 561298,
905364,1134742, 168133,1020103, 725192,
1462473, 69845, 610521, 627145,1315035,
217311, 315626, 757996, 528622,1364208,
463091,1003765, 872695, 446712, 495871,
1102086, 512460, 332041, 20749, 839962,
1167645, 299294,1184032, 676132, 938277,
50, 20942, 8192, 71, 73,
725469,1315294, 627167, 20749, 839962,
1167645,1184032, 676132, 70113, 938277,
332260, 8192, 20966, 676328, 938473,
8192, 20970, 8192, 119276, 643572,
922102, 8192,1315320, 627167, 20749,
839962,1167645,1184032, 676132, 70113,
938277, 332260, 8192, 758265, 8192,
119291, 8192, 20989, 8192, 37375,
53760, 8192, 20994, 8192,1495556,
12300, 111,1446405, 725192,1462473,
70034, 610521, 627092, 8192, 627209,
1446412, 725192,1462473, 70034, 610521,
8192, 37393, 53778, 8192, 21012,
86550, 676376, 8192,1167898,1446427,
725192,1462473, 69845, 610521, 627092,
1184032, 676132, 938277, 332260, 21024,
8192, 21032, 676394, 8192, 92,
1446444, 12537, 37425, 70194, 397876,
8192, 94, 96, 234038,1053239,
1299000,1036627,1266004,1331542, 954713,
1151324, 577874,1479012,1397094,1544553,
840043, 545133, 692591, 201073,1413490,
807293, 708991, 8192, 4, 132,
3, 6,1053242,1036627,1266004,
1331542, 954713,1151324,1479012,1397094,
1544553, 840043, 545133, 692591, 201073,
1413490, 807293, 708991, 8192, 86550,
676376, 8192, 14, 15, 53819,
16, 37437, 135742, 8192, 21058,
627268, 8192,1167942,1184032, 676132,
70113, 938277, 332260, 21024, 19,
53831, 20, 37449, 135754, 8192,
53836, 23, 627278, 24, 627280,
8192, 627281, 8192, 35,1036883,
1479012, 954964,1397094,1544553, 840043,
201073,1413490, 807293, 708991, 8192,
21078, 8192, 627288, 8192, 2,
660058, 8192, 12, 1,1495644,
12300, 10, 823901, 8192, 70056,
119202, 397735, 742030, 8192, 742033,
8192, 20966, 8192, 21139, 8192,
47, 49, 86677,1446551, 725192,
1462473, 70034, 610521, 627092, 8192,
627356, 8192,1086109, 184990, 529056,
463091, 82, 83, 84, 116,
54,1118633, 495871,1102086, 151979,
8192, 21154, 8192, 676516, 8192,
1495718, 12300, 57, 365223, 8192,
1315497, 12512,1315500, 12512, 21165,
8192, 135558, 430767, 8192, 86704,
8192, 676530, 8192, 86708, 8192,
68, 20888, 86432, 85,1430198,
12386,1315512,1446586, 725192,1462473,
69845, 610521, 627391, 20749, 839962,
1167645,1184032, 676132, 938277, 332260,
8192, 78, 77, 86432, 85,
676328, 938473, 8192, 21012, 8192,
1446594, 12537, 95, 97,1446599,
12537, 758476,1446605, 725192,1462473,
70034, 610521, 627092, 8192,1446609,
12537,1446613, 12537, 122, 889561,
8192,1315547, 12512,1315548, 12512,
105,1446622, 12537, 676578, 8192,
103, 119202, 397735, 70056, 112,
21139, 86757, 113, 70056, 119202,
397735, 660199, 8192, 115, 627433,
8192, 627434, 8192, 250604, 8192,
53997, 130, 99, 37615, 70056,
119202, 397735, 8192,1167898,1184032,
676132, 70113, 938277, 332260, 21024,
8192,1315569, 12512, 660211, 8192,
70056, 119202, 397735, 660213, 8192,
93,1168119, 12833,1168120, 12833,
9, 7,1053433, 12607, 5,
627450, 8192, 17, 725755,1479420,
840446, 8192,1168128, 12833, 660226,
8192, 34, 627460, 8192, 22,
1037062, 12659, 627463, 8192, 119561,
29, 39, 21259, 8192, 37,
21261, 8192, 676623, 8192, 21265,
8192,1233682, 12290, 45,1495829,
1512214, 512097,1282154,1446001, 970869,
1347702, 151671,1085567, 594048, 987266,
1560709,1069191, 282761, 348299,1118349,
233614, 479376, 561298, 905364,1134742,
168133,1020103, 626797, 725192,1462473,
69845, 610521,1315035, 217311, 315626,
757996, 528622,1364208, 463091,1003765,
872695, 446712, 495871,1102086, 332041,
20749, 839962,1167645, 299294,1184032,
676132, 938277, 50,1315608,1446681,
12752,1315613, 12512,1446551, 12537,
725790, 8192, 37664, 70056, 119202,
397735, 8192, 87, 74, 21281,
8192, 21283, 8192, 86677, 8192,
37669, 8192, 104,1512230, 12439,
381735, 856873, 8192, 61,1446699,
12537, 64, 725808, 8192, 54066,
8192, 725812, 8192, 824118, 8192,
37688, 8192, 54073, 70056, 119202,
397735, 8192, 21139, 86432, 85,
37691, 70056, 119202, 397735, 8192,
37692, 70056, 119202, 397735, 8192,
125, 119202, 397735, 70056, 119,
119202, 397735, 70056, 120, 119202,
397735, 70056, 121,1315645, 12512,
124, 37694, 8192, 119202, 397735,
70056, 107, 37696, 70465, 8192,
627523, 8192, 21316, 8192, 118,
37702, 8192, 129, 676679, 8192,
86856, 86, 37707, 8192,1315660,
12512, 234317, 8192, 101, 100,
8, 40, 42, 53831, 43,
627278, 8192, 103246, 8192,1037136,
12659, 119633, 32, 38, 119635,
27,1168213, 12833, 86870, 8192,
1168216, 12833, 37722, 8192, 36,
135255, 430940, 8192, 46, 414557,
48, 109, 119202, 397735, 70056,
108, 110, 86878, 8192, 81,
1315679, 12512,1315681, 12512, 56,
58,1315683, 12512,1315685, 12512,
54119, 70056, 119202, 397735, 8192,
86889, 8192, 676715, 8192, 86893,
8192,1512303, 12439, 70,1315697,
12512, 79, 80, 123, 119667,
8192, 127, 676725, 8192, 114,
627575, 8192, 98, 131, 627576,
840569, 8192, 91, 90, 102,
1168250, 12833, 18,1168252, 12833,
791421, 8192, 30, 725886, 8192,
103296, 8192, 627586, 8192, 11,
72, 106, 37764, 8192, 37765,
8192, 365446, 8192, 365448, 8192,
1315722, 12512, 54156, 8192, 54158,
8192, 54160, 8192, 414557, 8192,
37778, 8192,1446803, 12537, 37783,
8192, 117, 88, 89, 37784,
8192, 31, 28, 86938, 8192,
1168283, 12833, 119709, 25, 75,
76,1512351, 12439,1512352, 12439,
37793, 8192, 725922, 8192, 676772,
8192,1446822, 12537, 69, 119202,
397735, 70056, 126, 128, 627627,
8192, 41, 37805, 8192, 791471,
8192, 60, 59, 62, 37808,
8192, 37809, 8192, 37810, 70056,
119202, 397735, 8192, 660403, 8192,
627646, 8192, 26, 65, 66,
67, 840640,1037251,1479012, 954964,
1397094,1544553, 201073,1413490, 807293,
708991, 8192, 660420, 8192, 627278,
119750, 24, 21,1037251, 12659,
33);
symbol:=instruktion shift (-14);
if symbol=0 or symbol=vindue1 then
begin
aktion:=instruktion shift (-12) extract 2;
case aktion+1 of
begin
begin comment reducer;
nr:=instruktion extract 12;
semantik(nr,stakpil);
pr:=case nr of (
344067, 299010, 299010, 299010, 311299,
311298, 311299, 311300, 303107, 307203,
307206, 307203, 307202, 323585, 262145,
262145, 262146, 262148, 262145, 258049,
258057, 258050, 258049, 258049, 385029,
385031, 385027, 385029, 368642, 368644,
368645, 368643, 286730, 286722, 237569,
352259, 348162, 348163, 315394, 315395,
331782, 331779, 331779, 380929, 380931,
372740, 372738, 372737, 319490, 376832,
376833, 376833, 376833, 376834, 376833,
376836, 376834, 376836, 376839, 376839,
376835, 376839, 376833, 376835, 376840,
376840, 376840, 376834, 376838, 376836,
376833, 282629, 360449, 360451, 360454,
360454, 360450, 360450, 360452, 360452,
360452, 364546, 364546, 364546, 327681,
327683, 327683, 327685, 327685, 327684,
327684, 327681, 290818, 290817, 290818,
290817, 290818, 290820, 294914, 294915,
294915, 249860, 245762, 245763, 335874,
339973, 339971, 356355, 356355, 356355,
389121, 266242, 278530, 278532, 278530,
278530, 274437, 274435, 241667, 241667,
241667, 241666, 241668, 241667, 241667,
241670, 270340, 270342, 253955, 253954,
253956, 303106);
stakpil:=stakpil-pr extract 12;
vindue1:=pr shift (-12);
indeks:=syntaksstak(stakpil)
;recovering:=false;
glindeks:=indeks;
end reducer;
begin comment stak;
stakpil:=stakpil+1;
syntaksstak(stakpil):=indeks:=instruktion extract 12;
if vindue1 < 58 then
begin
staksemantik(vindue1,stakpil);
vindue1:=vindue2:=næstesymbol
end else vindue1:=vindue2
;recovering:=false;
glindeks:=indeks;
end stak;
begin comment fejl;
if -, recovering then fejl(vindue2);
recovering:=true;
vindue1:=vindue2:=næstesymbol;
indeks:=glindeks;
end fejl;
begin comment hop;
indeks:=instruktion extract 12
end hop
end case-sætning
end if symbol=0 or symbol=vindue1 else indeks:=indeks+1;
goto løkke
end syntaksanalysator;
comment *******************************************************
stakning af terminale symbolers attributter
*******************************************************;
procedure staksemantik(symbol,stakpil);
value symbol,stakpil;
integer symbol,stakpil;
begin
att1(stakpil):=art;
if symbol=38 and art=0 then
begin comment *** termnalt symbol er navn ***;
att1(stakpil):=delnavn1;
att2(stakpil):=delnavn2;
att3(stakpil):=delnavn3;
end;
if symbol=41 then
begin comment *** terminalt symbol er pkonst ***;
att2(stakpil):=1 shift 3 add art;
att1(stakpil):=hkonst shift (-24);
att3(stakpil):=hkonst extract 24;
end;
if symbol=57 then
begin comment *** terminalt symbol er reeltalkonstant ***;
att2(stakpil):=12;
att1(stakpil):=rkonst shift (-24);
att3(stakpil):=rkonst extract 24;
end;
end staksemantik;
comment ********************************************************
* *
* semantik *
* *
********************************************************;
procedure semantik(prodnr,stakpil);
value prodnr,stakpil;
integer prodnr,stakpil;
begin
comment ********************************************************
stakning af semantiske fejl
********************************************************;
procedure fejl(fejlnr);
value fejlnr;
integer fejlnr;
begin
oklinie:=false;
fejlpil:=fejlpil+1;
fejlstak(1,fejlpil):=fejlnr;
fejlstak(2,fejlpil):=linienr;
if fejlpil=49 then fejl(2040);
if fejlnr=2040 then goto passstop;
goto stopsemantik;
end;
comment ********************************************************
udlæsning af programsektions genererede kode
********************************************************;
procedure procud(tøm);
value tøm;
boolean tøm;
begin
integer i,j,m,n;
comment *** listning af genereret kode ***;
if code then
begin
code:=false;
kodeud(2,kodeudpil):=zbase+zpil;
end;
if kodeudpil>0 then
begin
for i:=1 step 1 until kodeudpil do mnemoud(kodeud(1,i),
kodeud(2,i));
kodeudpil:=0;
end;
j:=zbase+zpil;
n:=j//256;
if n>0 then
begin comment *** udlæsning af hele segmenter ***;
for m:=0 step 1 until n-1 do
begin
outrec(save,128);
for i:=1 step 1 until 256 do
save.fi(i):=z(i+m*256);
end;
filnr:=filnr+n;
end;
if j mod 256 <> 0 then
begin
if tøm then
begin comment *** udlæsning af delsegment ***;
outrec(save,128);
for i:=1 step 1 until j mod 256 do
save.fi(i):=z(n*256+i);
for i:=j mod 256+1 step 1 until 256 do
save.fi(i):=0;
if (i-zbase+1)*2>maxadresse then maxadresse:=2*(i-zbase+1);
filnr:=filnr+1;
zbase:=-zpil;
end else
if n>0 then
begin comment *** flytning af delsegment til atart af kodebuffer ***;
for i:=1 step 1 until j mod 256 do z(i):=z(i+n*256);
for i:=j mod 256 + 1 step 1 until 1300 do z(i):=0;
end;
end;
zbase:=zbase-n*256;
blokstart:=zpil;
end procud;
comment ********************************************************
indsættelse af konstanttabel efter sektionens kode
********************************************************;
procedure indktab;
begin
if zpil+konstpil2-blokstart>1024 then fejl(2032);
if konstpil1>0 then
begin
j:=konstpil1;
for tom:=0 while j>0 do
begin
z(zbase+konsttab1(j)):=z(zbase+konsttab1(j))+2*(zpil+1-
konsttab1(j));
j:=j-1;
end;
konstpil1:=0;
for tom:=0 while j<=konstpil2//2 do
begin comment *** indsættelse af referencer til konstanttabel ***;
z(zbase+zpil+1+j):=konsttab2(j);
j:=j+1;
end;
konstpil2:=-1;
zpil:=zpil+j;
end;
end;
comment ********************************************************
søgning i navnetabel
********************************************************;
integer procedure idtabsøger(stakpil,område);
value område,stakpil;
integer område,stakpil;
begin
integer tom,i,grænse;
grænse:=if område extract 1=0 or kropniv=1 then 3 else hptop+1;
i:=if område>0 then idtabpil else hptop;
prøvnyid: for tom:=0 while att1(stakpil)<>idtab1(i) and i>grænse do
i:=i-1;
if att1(stakpil)<>idtab1(i) or (att2(stakpil)<>idtab2(i) or
att3(stakpil)<>idtab3(i)) then
begin
if i<grænse then fejl(2005) else
begin
i:=i-1;
goto prøvnyid;
end;
end;
idtabsøger:=i;
if xref then
begin
outrec6(zxref,8);
zxref.if2:=att1(stakpil);
zxref.if4:=att2(stakpil);
zxref.if6:=att3(stakpil);
zxref.if8:=1 shift 20 add linienr;
end;
end idtabsøger;
comment ********************************************************
indsættelse af hopfreferencer
********************************************************;
procedure indsæthop;
begin
integer i;
if hoppil>0 then
begin
for i:=1 step 1 until hoppil do
z(zbase+hoptab1(i)):=z(zbase+hoptab1(i))+
(idtab5(hoptab2(i))-2*hoptab1(i)) extract 12;
hoppil:=0;
end;
end indsæthop;
comment ********************************************************
indsættelse af navn i navnetabel
********************************************************;
procedure indsætid(stakpil,plads,mode,art,type,adresse);
value stakpil,plads,mode,art,type,adresse;
integer stakpil,plads,mode,art,type,adresse;
begin
integer tom,i;
i:=curridlimit;
comment *** søgning om navnet er der i forvejen ***;
prøvnyid: for tom:=0 while idtab1(i)<>att1(stakpil) and i<idtabpil do
i:=i+1;
if att1(stakpil)=idtab1(i) and (att2(stakpil)=idtab2(i) and
att3(stakpil)=idtab3(i)) then fejl(2001);
if i<idtabpil then
begin
i:=i+1;
goto prøvnyid;
end;
comment *** indsættelse af navnet ***;
idtabpil:=idtabpil+1;
idtab1(idtabpil):=att1(stakpil);
idtab2(idtabpil):=att2(stakpil);
idtab3(idtabpil):=att3(stakpil);
idtab4(idtabpil):=plads shift 4 add mode shift 4 add art
shift 4 add type;
idtab5(idtabpil):=adresse+reladr(mode);
if xref then
begin
outrec6(zxref,8);
zxref.if2:=att1(stakpil);
zxref.if4:=att2(stakpil);
zxref.if6:=att3(stakpil);
zxref.if8:=linienr;
end;
end indsætid;
comment ********************************************************
generering af maskinordre i det generelle tilfælde med
operator, register og operand.
********************************************************;
procedure dandyopkode(op,rpil,oppil);
value op,rpil,oppil;
integer op,rpil,oppil;
begin
integer nøgle,reg,rel,indir,index,displ;
comment *** sammenbygning af søgenøgle og søgning af tilladt
type-operator-kombination ****;
finddyop:
nøgle:=(op extract 6) shift 3 add att2(rpil) shift 3
add (att2(oppil) extract 3);
if op=7 then nøgle:=nøgle-64;
if nøgle>32 shift 3 add 6 shift 3 add 6 then fejl(2002);
i:=dyopslag(op extract 6);
for j:=0 while nøgle>dyoptab(i) shift (-12) do i:=i+1;
for j:=0 while nøgle<dyoptab(i) shift (-12) do i:=i-1;
if dyoptab(i) shift (-12) extract 12<>nøgle then
begin
if att2(oppil) shift (-3) extract 3 = 1 and
att2(oppil) extract 3 <> 1 then fejl(2003) else
begin
att2(oppil):=att2(oppil)+2; comment convert byte to word;
goto finddyop;
end;
end;
if att2(oppil) extract 6=1 and dyoptab(i) extract 3=1 then
fejl(2003);
if att2(oppil) shift (-3) extract 3 = 1 then
begin comment *** operanden er en konstant ***;
if att2(oppil) extract 3=1 then
begin comment *** typen er byte ***;
if dyoptab(i) extract 3=1 then
begin comment *** konstant indsættes i adressefelt ***;
o(dyoptab(i) shift (-6) extract 6+op shift (-6),
att1(rpil) extract 2,0,0,0,att3(oppil));
goto stopdandy;
end;
if op<4 then
begin comment *** operatorerne :=, + og - giver mulighed for at
indsætte byte-konstanter i adressefeltet ***;
case op of
begin
if att1(rpil)<4 then
begin
o(11,att1(rpil),0,0,0,att3(oppil));
goto stopdandy;
end;
if att1(rpil)<4 and att1(rpil)>0 then
begin
o(11,att1(rpil),0,0,att1(rpil),att3(oppil));
goto stopdandy;
end;
if att1(rpil)<4 and att1(rpil)>0 then
begin comment *** indexregister ***;
o(11,att1(rpil),0,0,att1(rpil),-att3(oppil));
goto stopdandy;
end;
end;
end;
end;
comment ******* indsættelse af konstant i konstanttabel *******;
case (att2(oppil) extract 3)//4+1 of
begin
begin comment *** byte eller word indsættes som word ***;
j:=1;
comment *** søgning om konstanten er der i forvejen ***;
for tom:=0 while j<=konstpil2 and konsttab2(j//2)<>
att3(oppil) do j:=j+2;
if j>konstpil2 then
begin comment *** indsættelse af konstant ***;
if j-konstpil2=1 then j:=j+2;
konsttab2(j//2):=att3(oppil);
konstpil2:=j;
end;
if att2(oppil) extract 3=1 then att2(oppil):=3;
end;
begin comment *** real eller double ***;
j:=3;
comment *** søgning om konstanten er der i forvejen ***;
for tom:=0 while j<=konstpil2 and (konsttab2(j//2-1)<>
att1(oppil) or konsttab2(j//2)<>att3(oppil)) do
j:=j+2;
if j>konstpil2 then
begin comment *** indsættelse af konstant ***;
if j-konstpil2=1 then j:=j+2;
if konsttab2(j//2-1)<>att1(oppil) then j:=j+2;
konsttab2(j//2-1):=att1(oppil);
konsttab2(j//2):=att3(oppil);
konstpil2:=j;
end;
end;
end;
comment *** indsætttelse af reference til konstanttabellen ***;
konstpil1:=konstpil1+1;
konsttab1(konstpil1):=zpil+1;
comment *** beskrivelse af konstant som incode-operand ***;
att3(oppil):=-1;
att1(oppil):=1 shift 18 + j + (zpil+1)*2;
end;
if att3(oppil)<>-1 then
begin comment *** udpakning af modifikationsbeskrivelse ***;
rel:=att3(oppil) shift (-18) extract 1;
indir:=att3(oppil) shift (-19) extract 1;
index:=att3(oppil) shift (-16) extract 2;
displ:=if rel=1 then (att3(oppil) extract 16 - 2*(zpil+1))
else att3(oppil) ;
comment *** generering af am-ordre ***;
o(9,0,rel,indir,index,displ);
end;
comment *** udpakning af operandbeskrivelse ***;
reg:=att1(rpil);
rel:=att1(oppil) shift (-18) extract 1;
indir:=dyoptab(i) extract 3 +(att1(oppil) shift (-19));
index:=att1(oppil) shift (-16) extract 2;
displ:=if rel=1 then att1(oppil) extract 16 - 2*(zpil+1)
else att1(oppil) extract 16;
if op=14 then
begin
if att2(oppil) extract 3 shift (-1)=1 then displ:=displ-1;
if att2(oppil) extract 3 shift (-1)=2 then displ:=displ-3;
end;
if (index=0 and rel=0) and (displ=2 or (displ=4 or displ=6)) then
begin comment *** indirekte via indxregister omsættes til indexadr. ***;
if indir>0 then
begin
index:=displ//2;
indir:=indir-1;
displ:=0;
end;
end;
if indir>1 then
begin comment *** generering af ekstra am-ordrer til indirekte adr.***;
o(9,0,rel,1,index,displ);
if indir>2 then for j:=3 step 1 until indir do o(9,0,0,1,0,0);
comment *** generering af selve ordren ***;
o(dyoptab(i) shift (-6) extract 6+op shift (-6),
att1(rpil) extract 2,0,1,0,0);
end else
o(dyoptab(i) shift (-6) extract 6+op shift (-6),
att1(rpil) extract 2, rel,indir,index,displ);
stopdandy:
att2(rpil):=dyoptab(i) shift (-3) extract 3;
if op=7 then att1(rpil):=(att1(rpil)-1) extract 3;
end dandyopkode;
comment ********************************************************
sammenpakning af maskinordrer
********************************************************;
procedure o(instr,reg,rel,indir,index,disp);
value instr,reg,rel,indir,index,disp;
integer instr,reg,rel,indir,index,disp;
begin
if zpil-blokstart>1023 then fejl(2032);
zpil:=zpil+1;
if disp<-2048 then fejl(2033);
if disp>2047 then
begin
if disp>4094 or rel=0 then fejl(2033);
z(zbase+zpil):=9 shift 18 add 2046;
zpil:=zpil+1;
disp:=disp-2048;
end;
z(zbase+zpil):=instr shift 2 add reg shift 1 add rel shift 1
add indir shift 2 add index shift 12 add (disp extract 12);
end o;
comment ********************************************************
indsættelse af initialiseringskonstanter (incode)
********************************************************;
procedure placerkonst(type,adr);
value type,adr;
integer type,adr;
begin
case type of
begin
begin comment *** byte ***;
if att2(stakpil)<>9 then fejl(2003);
if adr mod 2=1 then
z(zbase+adr//2):=z(zbase+adr//2) shift (-12) shift 12
add (att3(stakpil) extract 12) else
z(zbase+adr//2):=att3(stakpil) shift 12;
end;
begin comment *** ref ***;
if (att2(stakpil)<>9 and att2(stakpil)<>10) and
att2(stakpil)<>11 then fejl(2003);
z(zbase+adr//2):=att3(stakpil);
end;
begin comment *** word ***;
if att2(stakpil)<>9 and att2(stakpil)<>11 then fejl(2003);
z(zbase+adr//2):=att3(stakpil);
end;
begin comment *** real ***;
if att2(stakpil)<>12 then fejl(2003);
z(zbase+adr//2):=att3(stakpil);
z(zbase+adr//2-1):=att1(stakpil);
end;
begin comment *** double ***;
if att2(stakpil) extract 1<>1 then fejl(2003);
z(zbase+adr//2):=att3(stakpil);
z(zbase+adr//2-1):=att1(stakpil);
end;
end;
end placerkonst;
comment ********************************************************
beregning af udtryk bestående af heltalskonstanter
********************************************************;
procedure hkonstexpr(op);
value op;
integer op;
begin
if att2(stakpil-2)<12 then hkonst:=att3(stakpil-2) else
hkonst:=att1(stakpil-2) shift 24 add att3(stakpil-2);
if att2(stakpil)<12 then hkonst1:=att3(stakpil) else
hkonst1:=att1(stakpil) shift 24 add att3(stakpil);
case op of
begin
hkonst:=hkonst+hkonst1;
hkonst:=hkonst-hkonst1;
hkonst:=hkonst*hkonst1;
;
hkonst:=hkonst//hkonst1;
hkonst:=hkonst mod hkonst1;
end;
if hkonst>8388607 or hkonst<-8388608 then type:=5 else
if hkonst>2047 or hkonst<-2048 then type:=3 else type:=1;
att2(stakpil-2):=1 shift 3 add type;
att1(stakpil-2):=hkonst shift (-24);
att3(stakpil-2):=hkonst extract 24;
end hkonstexpr;
comment ********************************************************
beregning udtryk bestående af reeltalskonstanter
********************************************************;
procedure rkonstexpr(op);
value op;
integer op;
begin
rkonst:=att1(stakpil-2) shift 24 add att3(stakpil-2);
rkonst1:=att1(stakpil) shift 24 add att3(stakpil);
case op of
begin
rkonst:=rkonst+rkonst1;
rkonst:=rkonst-rkonst1;
rkonst:=rkonst*rkonst1;
rkonst:=rkonst/rkonst1;
end;
att3(stakpil-2):=rkonst extract 24;
att1(stakpil-2):=rkonst shift (-24);
end rkonstexpr;
comment ********************************************************
case-konstruktion indeholdende semantikken
hørende til de enkelte produktioner i sproget
********************************************************;
case prodnr of
begin
begin comment ----- program ::= kropstart4 end . -----;
procud(true);
goto passstop;
end;
begin comment ----- kropstart1 ::= navn begin -----;
recovpoint:=stakpil-1;
att1(stakpil):=att1(stakpil-1);
att2(stakpil):=att2(stakpil-1);
att3(stakpil):=att3(stakpil-1);
att1(stakpil-1):=idtabpil;
att2(stakpil-1):=0;
att3(stakpil-1):=1;
kropniv:=kropniv+1;
dyn:=0;
frierkl:=true;
mode:=4;
if kropniv>1 then
begin
att3(stakpil-1):=idtabsøger(stakpil,2);
if idtab4(att3(stakpil-1)) shift (-4) extract 4<>5
then fejl(2003);
end;
reladr(3):=-1;
if kropniv>1 then reladr(2):=2*zpil+1;
end;
begin comment ----- kropstart1 ::= kropstart1 compkom -----
if kropniv>1 or (att1(stakpil)>0 and att1(stakpil)<>3
then fejl(2004);
end;
begin comment ----- kropstart1 ::= kropstart1 sk -----;
end;
begin comment ----- kropstart2 ::= kropstart1
modeerkl erklæring
if att1(stakpil)<1 then fejl(2004);
att2(stakpil-2):=1;
end;
begin comment ----- kropstart2 ::= kropstart1 erklæring -----;
att2(stakpil-1):=att1(stakpil);
if att1(stakpil) = 0 then att1(stakpil-1):=idtabpil;
end;
begin comment ----- kropstart2 ::= kropstart2
sk erklæring -----;
if att1(stakpil)<att2(stakpil-2) then fejl(2004);
if att1(stakpil) = 0 then att1(stakpil-2):=idtabpil;
att2(stakpil-2):=att1(stakpil);
end;
begin comment ----- kropstart2 ::= kropstart2 sk
modeerkl erklæring -----;
if att1(stakpil)=0 then fejl(2004);
att2(stakpil-3):=2;
end;
begin comment ----- kropstart3 ::= kropstart2 sk begin -----;
if dyn=1 then
begin
zpil:=reladr(2)//2+2;
dynref:=2*zpil-1;
end else
begin
zpil:=reladr(2)//2+1;
dynref:=-5000;
end;
basisref:=zpil;
z(zbase+zpil):=-2*zpil;
if kropniv=1 then
begin
att1(stakpil-2):=idtabpil;
hptop:=idtabpil;
if -, fp then
begin
zpil:=zpil+2;
indhop:=2*zpil+2;
o(23,0,1,0,0,-2);
o(23,3,1,0,0,-6);
o(20,1,0,0,3,22);
end else indhop:=2*zpil-1534;
o(7,1,1,0,0,fpplads-2*(zpil+1));
o(23,1,1,0,0,fpplads-2*(zpil+1));
o(11,1,0,0,0,0);
o(11,1,0,0,1,2);
o(43,1,0,0,0,2*(procantal+knudeantal));
o(13,0,1,0,0,10);
o(20,0,1,0,0,fpplads-2*(zpil+1));
o(7,0,1,0,1,fpplads-2*(zpil+1));
o(23,0,1,0,1,fpplads-2*(zpil+1));
o(13,0,1,0,0,-12);
o(20,1,1,0,0,fpplads-2*(zpil+1));
if -, fp then
begin
o(11,3,1,0,0,2*(procantal+knudeantal+grenantal-1-zpil)+fpplads);
o(14,0,0,0,0,-1996);
o(20,0,1,0,0,-34);
o(20,3,1,0,0,-38);
end;
end else
proctab(idtab4(att3(stakpil-2)) shift (-16)):=2*zpil+2;
end;
begin comment ----- kropstart4 ::= kropstart3 sætnliste end -----;
recovpoint:=stakpil-2;
if kropniv>1 then
begin
j:=att3(stakpil-2);
for n:=0 while idtab1(j)<>0 do j:=j+1;
o(13,0,0,0,idtab4(att3(stakpil-2)) shift (-12) extract 2,
idtab3(j));
idtabpil:=curridlimit:=att1(stakpil-2);
end else
begin
if fp then
begin
o(11,2,0,0,0,0);
if 48-2*(zpil-1)<=2048 then
begin
o(9,0,1,1,0,(basisref-zpil-1)*2);
o(13,0,1,0,0,48+2*(basisref-zpil-1));
end else
o(13,0,1,0,0,48-2*(zpil+1));
end;
end;
indktab;
indsæthop;
procud(false);
end;
begin comment ----- kropstart4 ::= kropstart4 sk
body of kropstart4 end -----;
recovpoint:=stakpil-5;
kropniv:=kropniv-1;
idtabpil:=curridlimit:=att1(stakpil-5);
end;
begin comment ----- kropstart4 ::= kropstart4 sk compkom -----;
if att1(stakpil)<>1 and att1(stakpil)<>3 then fejl(2004);
end;
begin comment ----- kropstart4 ::= kropstart4 sk -----;
end;
begin comment ----- modeerkl ::= mode -----;
mode:=att1(stakpil);
frierkl:=false;
if mode=3 then dyn:=1;
end;
begin comment ----- erklæring ::= elementerkl -----;
att1(stakpil):=2;
end;
begin comment ----- erklæring ::= labelerkl -----;
att1(stakpil):=1;
end;
begin comment ----- erklæring ::= prerklhoved ) -----;
wliste:=wliste+7 shift (3*(att1(stakpil-1)-1));
att1(stakpil-1):=0;
idtabpil:=idtabpil+1;
idtab1(idtabpil):=0;
idtab2(idtabpil):=wliste;
idtab3(idtabpil):=(reladr(4)+1)//2*2;
end;
begin comment ----- erklæring ::= array navn of
elementerkl -----;
att1(stakpil-3):=1;
modedybde:=1;
if -, frierkl then fejl(2006);
reladr(2):=reladr(2)+2;
indsætid(stakpil-2,att1(stakpil),1,2,2,0);
idtab5(idtabpil):=reladr(2);
end;
begin comment ----- erklæring ::= initarray -----;
reladr(2):=(reladr(2)+(att1(stakpil)+1)*att2(stakpil))//2*2+1;
att1(stakpil):=2;
end;
begin comment ----- elementerkl ::= simpelerkl -----;
att1(stakpil):=(att1(stakpil)+1)//2*2;
reladr(mode):=reladr(mode)+att1(stakpil);
end;
begin comment ----- elementerkl ::= array ( konst :
konst ) navn of elementerkl -----;
modedybde:=modedybde-1;
if modedybde=1 then mode:=gemmode
else reladr(4):=gemreladr(modedybde);
if (att2(stakpil-4)<>9 or att2(stakpil-6)<>9) or
att3(stakpil-6)>att3(stakpil-4) then fejl(2041);
att1(stakpil-8):=((att3(stakpil-4)-att3(stakpil-6)+1)*
att1(stakpil)+1)//2*2;
indsætid(stakpil-2,att1(stakpil),mode,2,2,
1-att1(stakpil)*(att3(stakpil-6)));
if frierkl and modedybde=1 then fejl(2006);
reladr(mode):=reladr(mode)+att1(stakpil-8);
end;
begin comment ----- elementerkl ::= recerklhoved ) -----;
idtab4(att2(stakpil-1)):=idtab4(att2(stakpil-1))
+att1(stakpil-1) shift 12;
modedybde:=modedybde-1;
if modedybde>1 then reladr(4):=gemreladr(modedybde);
end;
begin comment ----- elementerkl ::= texterkl -----;
att1(stakpil):=att1(stakpil)-1;
reladr(mode):=reladr(mode)+(att1(stakpil)+1)//2*2;
end;
begin comment ----- elementerkl ::= type -----;
att1(stakpil):=1+att1(stakpil)//2+att1(stakpil)//4;
end;
begin comment ----- texterkl ::= text ( konst ) navn -----;
type:=7;
if att3(stakpil-2)>132 then fejl(2007);
textlængde:=(att3(stakpil-2)+2)//3*2;
indsætid(stakpil,textlængde,mode,4,type,1);
att1(stakpil-4):=textlængde+1;
att2(stakpil-4):=textlængde;
end;
begin comment ----- texterkl ::= text ( konst ) navn
:= streng -----;
if att1(stakpil)>att3(stakpil-4) or att3(stakpil-4)>132 then
fejl(2007);
if mode<>2 then fejl(2006);
type:=7;
textlængde:=(att3(stakpil-4)+2)//3*2;
indsætid(stakpil-2,textlængde,mode,4,type,1);
att1(stakpil-6):=textlængde+1;
att2(stakpil-6):=textlængde;
for i:=0 step 1 until textlængde//2 do
z(zbase+idtab5(idtabpil)//2+i):=streng(i);
end;
begin comment ----- texterkl ::= texterkl , navn -----;
indsætid(stakpil,att2(stakpil-2),mode,4,type,att1(stakpil-2));
att1(stakpil-2):=att1(stakpil-2)+att2(stakpil-2);
end;
begin comment ----- texterkl ::= texterkl , navn := -----;
if (att1(stakpil)//3+1)*2>att2(stakpil-4) then fejl(2007);
indsætid(stakpil-2,att2(stakpil-4),mode,4,type,att1(stakpil-4));
att1(stakpil-4):=att1(stakpil-4)+att2(stakpil-4);
for i:=0 step 1 until textlængde//2 do
z(zbase+idtab5(idtabpil)//2+i):=streng(i);
end;
begin comment ----- simpelerkl ::= type navn -----;
type:=att1(stakpil-1);
att2(stakpil-1):=1+type//2+type//4;
att1(stakpil-1):=att2(stakpil-1);
indsætid(stakpil,att2(stakpil-1),mode,1,type,att1(stakpil-1));
end;
begin comment ----- simpelerkl ::= type navn := konst -----;
if mode<>2 then fejl(30);
type:=att1(stakpil-3);
att2(stakpil-3):=type//2+type//4+1;
att1(stakpil-3):=att2(stakpil-3);
indsætid(stakpil-2,att2(stakpil-3),mode,1,type,att1(stakpil-3));
placerkonst(type,idtab5(idtabpil));
end;
begin comment ----- simpelerkl ::= simpelerkl , navn := konst -----;
if mode<>2 then fejl(2006);
att1(stakpil-4):=att1(stakpil-4)+att2(stakpil-4);
indsætid(stakpil-2,att2(stakpil-4),2,1,type,att1(stakpil-4));
placerkonst(type,idtab5(idtabpil));
end;
begin comment ----- simpelerkl ::= simpelerkl , navn -----;
att1(stakpil-2):=att1(stakpil-2)+att2(stakpil-2);
indsætid(stakpil,att2(stakpil-2),mode,1,type,att1(stakpil-2));
end;
begin comment ----- initarray ::= array ( konst : konst )
navn of type := -----;
modedybde:=1;
mode:=gemmode;
if (att2(stakpil-5)<>9 or att2(stakpil-7)<>9) or
att3(stakpil-7)>att3(stakpil-5) then fejl(2041);
if mode<>2 then fejl(2006);
type:=att1(stakpil-1);
att2(stakpil-9):=1+type//2+type//4;
indsætid(stakpil-3,att2(stakpil-9),2,2,type,1-att3(stakpil-7)*
att2(stakpil-9));
att1(stakpil-9):=att3(stakpil-5)-att3(stakpil-7);
end;
begin comment ----- initarray ::= initarray konst -----;
if att1(stakpil-1)<0 then fejl(2008);
att1(stakpil-1):=att1(stakpil-1)-1;
reladr(2):=reladr(2)+att2(stakpil-1);
placerkonst(type,reladr(2));
end;
begin comment ----- arraystart ::= array -----;
modedybde:=modedybde+1;
if modedybde=2 then gemmode:=mode
else gemreladr(modedybde-1):=reladr(4);
reladr(4):=-1;
mode:=4;
end;
begin comment ----- recerklhoved1 ::= record navn ( -----;
att2(stakpil-2):=2;
att1(stakpil-2):=0;
if mode<>4 then fejl(2006);
modedybde:=modedybde+1;
if modedybde=2 then gemmode:=mode
else gemreladr(modedybde-1):=reladr(4);
reladr(4):=-1;
if frierkl and modedybde=2 then
begin
reladr(2):=reladr(2)+2;
indsætid(stakpil-1,0,2,3,2,0);
end else
indsætid(stakpil-1,0,4,3,0,1);
att2(stakpil-2):=idtabpil;
end;
begin comment ----- recerklhoved ::= recerklhoved1
elementerkl -----;
att1(stakpil-1):=att1(stakpil);
end;
begin comment ----- recerklhoved ::= recerklhoved
sk elementerkl -----;
att1(stakpil-2):=att1(stakpil-2)+att1(stakpil);
end;
begin comment ----- labelerkl ::= label navn -----;
if -, frierkl then fejl(2006);
indsætid(stakpil,0,2,6,7,0);
end;
begin comment ----- labelerkl ::= labelerkl , navn -----;
indsætid(stakpil,0,2,6,7,0);
end;
begin comment ----- prerklhoved ::= procedure navn
( . register . -----;
if att1(stakpil-1)<1 or att1(stakpil-1)>3 then fejl(2009);
procnr:=procnr+1;
indsætid(stakpil-4,procnr shift 4+att1(stakpil-1),4,5,7,0);
for i:=0 step 1 until 3 do wfri(i):=true;
wfri(att1(stakpil-1)):=false;
wliste:=0;
reladr(4):=-1;
att1(stakpil-5):=1;
if procnr > procantal then fejl(2035);
end;
begin comment ----- prerklhoved ::= prerklhoved
sk register -----;
i:=att1(stakpil) extract 2;
if -, wfri(i) then fejl(2010) else wfri(i):=false;
if att1(stakpil) shift (-2)=1 then
begin
if -, wfri((i-1) extract 2) then fejl(2010) else
wfri((i-1) extract 2) := false;
end;
att1(stakpil-2):=att1(stakpil-2)+1;
wliste:=if att1(stakpil-2)>2 then wliste+(att1(stakpil)
shift (3*(att1(stakpil-2)-2))) else att1(stakpil);
end;
begin comment ----- prerklhoved ::= prerklhoved
sk simpelerkl -----;
if att1(stakpil-2)>1 then fejl(2004);
reladr(4):=reladr(4)+(att1(stakpil)+1)//2*2;
end;
begin comment ----- sætnliste ::= sætn -----;
recovpoint:=stakpil;
end;
begin comment ----- sætnliste ::= sætnliste sk sætn -----;
recovpoint:=stakpil;
end;
begin comment ----- sætn ::= if relation then sætn -----;
i:=att1(stakpil-2);
z(zbase+i):=13 shift 3 add 1 shift 15 add (2*(zpil+1-i));
end;
begin comment ----- sætn ::= markør sætn -----;
end;
begin comment ----- sætn ::= sætn2 -----;
end;
begin comment ----- markør ::= navn : -----;
i:=idtabsøger(stakpil-1,1);
if idtab4(i) shift (-4) extract 4<>6 then fejl(2021);
idtab5(i):=2*(zpil+1);
end;
begin comment ----- sætn2 ::= -----;
end;
begin comment ----- sætn2 ::= rex -----;
end;
begin comment ----- sætn2 ::= assignment -----;
end;
begin comment ----- sætn2 ::= prkald -----;
end;
begin comment ----- sætn2 ::= abeled prkald -----;
z(zbase+att1(stakpil)):=z(zbase+att1(stakpil))+att1(stakpil-1)
shift 18;
end;
begin comment ----- sætn2 ::= fpkald -----;
if -, fp then fejl(2012);
if att1(stakpil) shift (-12) extract 2<>1 then fejl(2011);
if att1(stakpil) extract 12 -2*(zpil+1)<-2048 then
begin
o(9,0,1,1,0,2*(basisref-zpil-1));
o(13,3,1,0,0,att1(stakpil) extract 12+2*(basisref-zpil-1));
end else
o(13,3,1,0,0,att1(stakpil) extract 12 -2*(zpil+1));
if att1(stakpil) extract 12=1048 or att1(stakpil)
extract 12=1046 then
begin
zpil:=zpil+1;
z(zbase+zpil):=layoutord;
end;
end;
begin comment ----- sætn2 ::= monitor ( pkonst ) -----
if -, mon then fejl(2013);
if att3(stakpil-1)>92 or att3(stakpil-1) extract 1=1
then fejl(2014);
zpil:=zpil+1;
z(zbase+zpil):=14 shift 7 add 1 shift 11 add att3(stakpil-1);
end;
begin comment ----- sætn2 ::= casestart2 end -----;
i:=att1(stakpil-1);
z(zbase+zpil):=13 shift 3 add 1 shift 15 add (2*(i+1));
casestakpil:=casestakpil-i-1;
n:=casestak(casestakpil+1)-1;
z(zbase+n):=z(zbase+n) add (2*(zpil-n));
for j:=1 step 1 until i do
o(13,0,1,0,0,2*(casestak(casestakpil+j)-zpil-1));
for j:=2 step 1 until i do
begin
n:=casestak(casestakpil+j)-1;
z(zbase+n):=13 shift 3 add 1 shift 15 add (2*(zpil+1-n));
end;
end;
begin comment ----- sætn2 ::= whiledel relation do sætn2 -----;
o(13,0,1,0,0,(att1(stakpil-3)-zpil-1)*2);
i:=att1(stakpil-2);
z(zbase+i):=13 shift 3 add 1 shift 15 add ((zpil+1-i)*2);
end;
begin comment ----- sætn2 ::= fordel step operand upto
operand do sætn2 -----;
dandyopkode(2,stakpil-6,stakpil-4);
dandyopkode(16,stakpil-6,stakpil-2);
o(13,0,1,0,0,(att3(stakpil-6)-zpil-1)*2);
end;
begin comment ----- sætn2 ::= fordel step operand downto
operand do sætn -----;
dandyopkode(3,stakpil-6,stakpil-4);
dandyopkode(1 shift 6+16,stakpil-6,stakpil-2);
o(13,0,1,0,0,(att3(stakpil-6)-zpil-1)*2);
end;
begin comment ----- sætn2 ::= call register operand -----;
att2(stakpil-1):=0;
if att1(stakpil-1)>3 then fejl(2009);
dandyopkode(31,stakpil-1,stakpil);
end;
begin comment ----- sætn2 ::= create navn ( rex , operand ) -----;
if att2(stakpil-3)<>0 and att2(stakpil-3)<>2 then fejl(2015);
n:=idtabsøger(stakpil-5,1);
if idtab4(n) shift (-4) extract 4<>2 then fejl(2003);
if idtab4(n) shift (-8) extract 4<>4 then fejl(2006);
if att2(stakpil-1) extract 3<>1 then fejl(2003);
o(23,att1(stakpil-3),1,0,0,idtab5(n)-2*(zpil+1));
o(11,att1(stakpil-3),0,0,0,idtab4(n) shift (-12));
att2(stakpil-3):=3;
dandyopkode(4,stakpil-3,stakpil-1);
o(7,att1(stakpil-3),1,0,0,idtab5(n)-2*(zpil+1));
o(23,att1(stakpil-3),1,0,0,idtab5(n)-2*(zpil+1));
end;
begin comment ----- sætn2 ::= gotosætn -----;
end;
begin comment ----- sætn2 ::= begin sætnliste end -----;
end;
begin comment ----- sætn2 ::= getchar ( . register .
, register -----;
if -, fp then fejl(2012);
if att1(stakpil-4)<>3 or att1(stakpil-1)<>2 then fejl(2016);
if 846-2*(zpil+1)<-2048 then
begin
o(9,0,1,1,0,(basisref-zpil-1)*2);
o(13,3,1,0,0,846+(basisref-zpil-1)*2);
end else
o(13,3,1,0,0,846-2*(zpil+1));
end;
begin comment ----- sætn2 ::= layout ( ppkonst , konst
, pkonst ) -----;
if att3(stakpil-5)>1 then fejl(2040);
if att3(stakpil-3)>127 then fejl(2040);
if att3(stakpil-1)>12 then fejl(2040);
layoutord:=att3(stakpil-5) shift 23+att3(stakpil-3)
shift 12+att3(stakpil-1);
end;
begin comment ----- sætn2 ::= write ( . register . ,
rex ) -----;
if -, fp then fejl(2012);
if att1(stakpil-4)<>3 then fejl(2016);
if att1(stakpil-1)=0 then
begin
if att2(stakpil-1)=2 then
begin
if 1012-2*(zpil+1)<-2048 then
begin
o(9,0,1,1,0,(basisref-zpil-1)*2);
o(13,3,1,0,0,1012+(basisref-zpil-1)*2);
end else
o(13,3,1,0,0,1012-2*(zpil+1));
end else
begin
if 1046-2*(zpil+1)<-2048 then
begin
o(9,0,1,1,0,(basisref-zpil-1)*2);
o(13,3,1,0,0,1046+(basisref-zpil-1)*2);
end else
o(13,3,1,0,0,1046-2*(zpil+1));
zpil:=zpil+1;
z(zbase+zpil):=layoutord;
end;
end;
if att1(stakpil-1)=2 then
begin
if att2(stakpil-1)=2 then fejl(2015);
if 890-2*(zpil+1)<-2048 then
begin
o(9,0,1,1,0,(basisref-zpil-1)*2);
o(13,3,1,0,0,890+(basisref-zpil-1)*2);
end else
o(13,3,1,0,0,890-2*(zpil+1));
end;
if att1(stakpil-1)<>0 and att1(stakpil-1)<>2 then fejl(2016);
end;
begin comment ----- sætn2 ::= ifthenelsestart sætn2 -----;
i:=att1(stakpil-1);
z(zbase+i):=13 shift 3 add 1 shift 15 add (2*(zpil+1-i));
end;
begin comment ----- sætn2 ::= inout ( rex , operand ) -----;
if att1(stakpil-3)>3 then fejl(2016);
dandyopkode(32,stakpil-3,stakpil-1);
end;
begin comment ----- sætn2 ::= inout ( operand ) -----;
att1(stakpil+1):=att2(stakpil+1):=0;
dandyopkode(32,stakpil+1,stakpil-1);
end;
begin comment ----- sætn2 ::= compkom -----;
if att1(stakpil)<>2 and att1(stakpil)<>3 then fejl(2004);
end;
begin comment ----- ifthenelsestart ::= if relation then sætn2 else -----;
zpil:=zpil+1;
att1(stakpil-4):=zpil;
i:=att1(stakpil-3);
z(zbase+i):=13 shift 3 add 1 shift 15 add (2*(zpil+1-i));
end;
begin comment ----- rex ::= register -----;
att2(stakpil):=if att1(stakpil)>3 then 6 else 0;
end;
begin comment ----- rex ::= rex := fpkald -----;
if att2(stakpil-2)<>0 then fejl(2004);
case att1(stakpil) shift (-12) extract 2 of
begin
fejl(2028);
begin
if att1(stakpil) extract 12-2*(zpil+1)<-2048 then
begin
o(9,0,1,1,0,2*(basisref-zpil-1));
o(11,att1(stakpil-2),1,0,0,att1(stakpil) extract 12
+2*(basisref-zpil-1));
end else
o(11,att1(stakpil-2),1,0,0,att1(stakpil) extract 12
-2*(zpil+1));
end;
o(11,att1(stakpil-2),0,0,0,att1(stakpil) extract 12);
fejl(2028);
end;
end;
begin comment ----- rex ::= rex := address ( operand ) -----;
if att2(stakpil-5)<>0 then fejl(2004);
dandyopkode(14,stakpil-5,stakpil-1);
end;
begin comment ----- rex ::= rex := key ( operand ) -----;
if att2(stakpil-5)<>0 then fejl(2004);
if att2(stakpil-1) shift (-3)<>0 then fejl(2018);
att2(stakpil-1):=0;
dandyopkode(17,stakpil-5,stakpil-1);
end;
begin comment ----- rex ::= rexstart operand -----;
if att3(stakpil-1)=13 then
begin
if att2(stakpil)<>9 or (att3(stakpil)>24 or att3(stakpil)
<0) then fejl(2019);
att2(stakpil):=11;
att3(stakpil):=(-1) shift (att3(stakpil)-24);
dandyopkode(11,stakpil-1,stakpil);
end else
dandyopkode(att3(stakpil-1),stakpil-1,stakpil);
end;
begin comment ----- rex ::= rexstart register -----;
att3(stakpil):=-1;
att2(stakpil):=if att1(stakpil)>3 then 6 else 0;
att1(stakpil):=att1(stakpil) shift 1 extract 3;
dandyopkode(att3(stakpil-1),stakpil-1,stakpil);
end;
begin comment ----- rex ::= - ( rex ) -----;
if att1(stakpil-1)>3 then fejl(2016);
if att2(stakpil-1)=2 then fejl(2003);
att1(stakpil-3):=att1(stakpil-1);
att2(stakpil-3):=att2(stakpil-1);
if att1(stakpil-1)=0 then o(9,0,0,1,0,0);
o(33,att1(stakpil-1),0,0,att1(stakpil-1),0);
end;
begin comment ----- rex ::= monop ( rex ) -----;
case att1(stakpil-3) of
begin
begin comment 'round';
if att2(stakpil-1)<>4 and att2(stakpil-1)<>6 then fejl(10);
o(53,att1(stakpil-1)-4,0,0,0,0);
att1(stakpil-3):=att1(stakpil-1)-4;
att2(stakpil-3):=3;
end;
begin comment 'float';
if att2(stakpil-1)<>3 and att2(stakpil-1)<>0 then fejl(2015);
o(32,att1(stakpil-1),0,0,0,0);
att1(stakpil-3):=att1(stakpil-1)+4;
att2(stakpil-3):=4;
end;
end;
end;
begin comment ----- rex ::= navn ( rex ) -----;
if att1(stakpil-1)<1 or att1(stakpil-1)>3 then fejl(2009);
if att2(stakpil-1) extract 3<>3 and att2(stakpil-1)<>0 then
fejl(2015);
n:=idtabsøger(stakpil-3,1);
if idtab4(n) shift (-4) extract 4<>2 then fejl(2003);
rkonst:=idtab4(n) shift (-12);
att1(stakpil+1):=0;
rkonst1:=0.5;
if idtab4(n) shift (-12)<>1 then
begin
if rkonst shift (-12)=rkonst1 shift (-12) then
begin
att2(stakpil+1):=9;
att3(stakpil+1):=rkonst extract 12-1;
dandyopkode(12,stakpil-1,stakpil+1);
end else
begin
att2(stakpil+1):=11;
att3(stakpil+1):=idtab4(n) shift (-12);
dandyopkode(4,stakpil-1,stakpil+1);
end;
end;
if idtab4(n) shift (-4) extract 8=34 then
o(11,att1(stakpil-1),1,0,att1(stakpil-1),idtab5(n)
-2*(zpil+1));
if idtab4(n) shift (-4) extract 8=18 then
o(7,att1(stakpil-1),1,0,0,idtab5(n)-2*(zpil+1));
if idtab4(n) shift (-4) extract 8=66 then
o(11,att1(stakpil-1),0,0,att1(stakpil-1),idtab5(n));
att1(stakpil-3):=att1(stakpil-1);
att2(stakpil-3):=2;
end;
begin comment ----- rexstart ::= rex := -----;
att3(stakpil-1):=1;
end;
begin comment ----- rexstart ::= rex dyop -----;
att3(stakpil-1):=att1(stakpil);
end;
begin comment ----- rexstart ::= rex - -----;
att3(stakpil-1):=3;
end;
begin comment ----- operand ::= navn -----;
if att1(stakpil)=100 shift 16 and att2(stakpil)
+att3(stakpil)=0 then
begin
att1(stakpil):=1 shift 18 add dynref;
att2(stakpil):=2;
att3(stakpil):=-1;
end else
begin
i:=idtabsøger(stakpil,1);
n:=idtab4(i) shift (-4) extract 8;
if n=69 then
begin
att3(stakpil):=3 shift 18 add (2*basisref+1);
att2(stakpil):=7;
att1(stakpil):=3 shift 18 add ((idtab4(i) shift (-16) +
767+basisref)*2);
end else
begin
if ((n<>38 and n<>36) and (n<>33 and n<>35)) and n<>18
then fejl(2019);
att1(stakpil):=1 shift 18 add idtab5(i);
att2(stakpil):=idtab4(i) extract 4;
att3(stakpil):=-1;
end;
end;
end;
begin comment ----- operand ::= ( rex ) -----;
att1(stakpil-2):=att1(stakpil-1) shift 1 extract 3;
att2(stakpil-2):=att2(stakpil-1);
att3(stakpil-2):=-1;
end;
begin comment ----- operand ::= navn . navn -----;
if att1(stakpil-2)=98 shift 16 and (att2(stakpil-2)=0 and
att3(stakpil-2)=0) then
begin
i:=idtabsøger(stakpil,0);
n:=idtab4(i) shift (-4) extract 8;
if ((n<>38 and n<>36) and (n<>33 and n<>35)) and n<>18
then fejl(2019);
att1(stakpil-2):=1 shift 18 add idtab5(i)+basisref*2;
att2(stakpil-2):=idtab4(i) extract 4;
att3(stakpil-2):=3 shift 18 add (2*basisref+1);
end else
begin
if att1(stakpil-2)=100 shift 16 and
att2(stakpil-2)+att3(stakpil-2)=0 then
begin
i:=idtabsøger(stakpil,1);
if idtab4(i) shift (-4) extract 8<>49 then fejl(2019);
att1(stakpil-2):=idtab5(i);
att2(stakpil-2):=idtab4(i) extract 4;
att3(stakpil-2):=3 shift 18+dynref;
end else
begin
i:=idtabsøger(stakpil-2,1);
n:=idtab4(i) shift (-4) extract 8;
if n<>18 and (n<>33 and n<>35) then fejl(2019);
if idtab4(i) extract 4<>2 then fejl(2003);
att3(stakpil-2):=3 shift 18 add idtab5(i);
i:=idtabsøger(stakpil,2);
if idtab4(i) shift (-4) extract 8<>65 then fejl(2019);
att1(stakpil-2):=idtab5(i);
att2(stakpil-2):=idtab4(i) extract 4;
end;
end;
end;
begin comment ----- operand ::= ( rex ) . navn -----;
if att1(stakpil-3)<1 or att1(stakpil-3)>3 then fejl(2009);
if att2(stakpil-3)<>2 and att2(stakpil-3)<>0 then fejl(2015);
i:=idtabsøger(stakpil,2);
j:=idtab4(i) shift (-4) extract 8;
if j <> 65 and j <> 68 then fejl(2019);
att1(stakpil-4):=att1(stakpil-3) shift 16 add idtab5(i);
att2(stakpil-4):=if j = 68 then 7 else idtab4(i) extract 4;
att3(stakpil-4):=-1;
end;
begin comment ----- operand ::= ( rex ) . type -----;
if att1(stakpil-3)<1 or att1(stakpil-3)>3 then fejl(2009);
att1(stakpil-4):=att1(stakpil-3) shift 16 +
att1(stakpil)//2+att1(stakpil)//4;
att2(stakpil-4):=att1(stakpil);
att3(stakpil-4):=-1;
end;
begin comment ----- operand ::= type pkonst of operand -----;
type:=att1(stakpil-3);
hkonst:=att3(stakpil-2);
if type<>1 and type<>3 then fejl(2003);
if att2(stakpil) shift (-3)<>0 then fejl(2018);
case (type+1)//2 of
begin
begin
if att2(stakpil) extract 3<2 then fejl(2003);
if hkonst>(att2(stakpil) extract 3)//2*2 then fejl(2020);
att1(stakpil-3):=att1(stakpil)+hkonst
-(if att2(stakpil)>3 then 3 else 1);
end;
begin
if att2(stakpil) extract 3<4 then fejl(2003);
if hkonst>1 then fejl(2020);
att1(stakpil-3):=att1(stakpil)+2*hkonst-2;
end;
end;
att2(stakpil-3):=type;
att3(stakpil-3):=att3(stakpil);
end;
begin comment ----- operand ::= type ( operand ) -----;
if att2(stakpil-1)<>2 then fejl(2003);
i:=1 shift 19;
att2(stakpil-3):=att1(stakpil-3);
att1(stakpil-3):=att1(stakpil-1)+i;
att3(stakpil-3):=att3(stakpil-1);
end;
begin comment ----- operand ::= konst -----;
end;
begin comment ----- konst ::= konstexpr ) -----;
end;
begin comment ----- konst1 ::= pkonst -----;
end;
begin comment ----- konst1 ::= - pkonst -----;
lpackkonst:=att1(stakpil);
lpackkonst:=lpackkonst shift 24 add att3(stakpil) * (-1);
att3(stakpil-1):=lpackkonst extract 24;
att1(stakpil-1):=lpackkonst shift (-24);
att2(stakpil-1):=att2(stakpil);
end;
begin comment ----- konst ::= rkonst -----;
end;
begin comment ----- konst ::= - rkonst -----;
lpackkonst:=att1(stakpil);
lpackkonst:=lpackkonst shift 24 add att3(stakpil);
rpackkonst:=real lpackkonst * (-1.0);
att3(stakpil-1):=rpackkonst extract 24;
att1(stakpil-1):=rpackkonst shift (-24) extract 24;
att2(stakpil-1):=12;
end;
begin comment ----- konst1 ::= compord ( navn ) -----;
if att1(stakpil-3) extract 6<>4 then fejl(2004);
if att1(stakpil-1)=100 shift 16 and att2(stakpil-1)+
att3(stakpil-1)=0 then
begin
if att1(stakpil-3)=2 then fejl(2004);
att3(stakpil-3):=(reladr(3)+1)//2*2;
att2(stakpil-3):=9;
end else
begin
i:=idtabsøger(stakpil-1,2);
if att1(stakpil-3) shift (-6) =1 then
begin
if idtab4(i) shift (-4) extract 4 > 3 then fejl(2021);
att3(stakpil-3):=idtab4(i) shift(-12);
att2(stakpil-3):=1 shift 3 add 1;
end else
begin
if idtab4(i) shift (-4) extract 4 > 4 then fejl(2021);
att2(stakpil-3):=1 shift 3 add 1;
att3(stakpil-3):=idtab5(i);
if idtab4(i) shift (-4) extract 4 = 1 then
begin
j:=idtab4(i) extract 4;
if j shift (-1) = 1 then att3(stakpil-3):=att3(stakpil-3)-1;
if j shift (-1) = 2 then att3(stakpil-3):=att3(stakpil-3)-3;
end;
end;
end;
att1(stakpil-3):=0;
end;
begin comment ----- konstexpr ::= ( konst -----;
att1(stakpil-1):=att1(stakpil);
att2(stakpil-1):=att2(stakpil);
att3(stakpil-1):=att3(stakpil);
end;
begin comment ----- konstexpr ::= konstexpr dyop konst -----;
n:=att1(stakpil-1) extract 6;
if att2(stakpil-2) extract 1=1 and
att2(stakpil) extract 1=1 then
begin
if (n<2 or n>7) or n=5 then fejl(2002);
hkonstexpr(n-1);
end else
begin
if att2(stakpil-2) extract 3<>4 or
att2(stakpil) extract 3 <>4 then fejl(2003);
if n<2 or n>5 then fejl(2002);
rkonstexpr(n-1);
end;
end;
begin comment ----- konstexpr ::= konstexpr - konst -----;
if att2(stakpil-2) extract 1=1 and
att2(stakpil) extract 1=1 then hkonstexpr(2) else
begin
if att2(stakpil-2) extract 3<>4 or
att2(stakpil) extract 3<>4 then fejl(2003);
rkonstexpr(2);
end;
end;
begin comment ----- casestart1 ::= case rex of begin -----;
casestakpil:=casestakpil+1;
casestak(casestakpil):=zpil+3;
if att1(stakpil-2)=0 or att1(stakpil-2)>3 then fejl(2009);
o(9,0,0,0,att1(stakpil-2),0);
o(13,0,1,0,att1(stakpil-2),0);
end;
begin comment ----- casestart2 ::= casestart1 sætn -----;
recovpoint:=stakpil-1;
att1(stakpil-1):=1;
zpil:=zpil+1;
casestakpil:=casestakpil+1;
casestak(casestakpil):=zpil+1;
end;
begin comment ----- casestart2 ::= casestart2 sk sætn -----;
att1(stakpil-2):=att1(stakpil-2)+1;
zpil:=zpil+1;
casestakpil:=casestakpil+1;
casestak(casestakpil):=zpil+1;
end;
begin comment ----- prkald ::= prkstart ) -----;
n:=att1(stakpil-1);
att1(stakpil-1):=zpil;
if wliste<>7 then fejl(2023);
procref:=2*((if fp then 767 else -1)+idtab4(att2(stakpil-1)) shift (-16));
if procref-(zpil+1)*2<-2048 then
begin
o(9,0,1,1,0,(basisref-zpil-1)*2);
o(13,n,1,1,0,procref+(basisref-zpil-1)*2);
end else
o(13,n,1,1,0,procref-2*(zpil+1));
att1(stakpil-1):=zpil;
if partabpil>0 then
begin
for i:=1 step 1 until partabpil do
z(zbase+partab1(i)):=z(zbase+partab1(i))+
2*(zpil+1-partab1(i));
zpil:=zpil+(idtab5(prkaldpil-1)+1)//2;
end;
end;
begin comment ----- prkstart ::= navn ( . register . -----;
prkaldpil:=2;
prkaldpil:=idtabsøger(stakpil-4,2);
if idtab4(prkaldpil) shift (-4) extract 4<>5 then fejl(2021);
if att1(stakpil-1)<>idtab4(prkaldpil) shift (-12)
extract 4 then fejl(2024);
att1(stakpil-4):=att1(stakpil-1);
att2(stakpil-4):=prkaldpil;
prkaldpil:=prkaldpil+1;
wliste:=idtab2(prkaldpil);
partabpil:=0;
end;
begin comment ----- prkstart ::= prkstart , rex -----;
if idtab1(prkaldpil)<>0 then
begin
n:=idtab4(prkaldpil) extract 4;
if att2(stakpil)<>n and ((att2(stakpil)=0 and n>3) or
(att2(stakpil)=6 and n<4)) then fejl(2025);
o(case (idtab4(prkaldpil) extract 4)//2+1 of (26,23,55),
att1(stakpil) extract 2,1,0,0,idtab5(prkaldpil));
partabpil:=partabpil+1;
partab1(partabpil):=zpil;
prkaldpil:=prkaldpil+1;
wliste:=idtab2(prkaldpil);
end else
begin
if att1(stakpil)<>wliste extract 3 then fejl(2023);
wliste:=wliste shift (-3);
end;
end;
begin comment ----- relation ::= rex relop rex -----;
att1(stakpil+1):=att1(stakpil-2);
att2(stakpil+1):=att2(stakpil-2);
att1(stakpil-2):=zpil;
att3(stakpil):=-1;
att1(stakpil):=att1(stakpil) shift 1;
if att1(stakpil-1)>6 then
begin
dandyopkode((att1(stakpil-1)-7) shift 6+16,stakpil+1,
stakpil);
o(13,0,1,0,0,4);
end else
dandyopkode((att1(stakpil-1)-1) shift 6+16,stakpil+1,
stakpil);
zpil:=zpil+1;
att1(stakpil-2):=zpil;
end;
begin comment ----- relation ::= rex relop operand -----;
att1(stakpil+1):=att1(stakpil-2);
att2(stakpil+1):=att2(stakpil-2);
att1(stakpil-2):=zpil;
if att1(stakpil-1)>6 then
begin
dandyopkode((att1(stakpil-1)-7) shift 6+16,
stakpil+1,stakpil);
o(13,0,1,0,0,4);
end else
dandyopkode((att1(stakpil-1)-1) shift 6+16,stakpil+1,
stakpil);
zpil:=zpil+1;
att1(stakpil-2):=zpil;
end;
begin comment ----- relation ::= reserved relop operand -----;
n:=att1(stakpil-2);
att1(stakpil-2):=zpil;
if att1(stakpil-1)<>6 then fejl(2026);
if n>2 then fejl(2027);
att1(stakpil+1):=att2(stakpil+1):=0;
case n of
begin
dandyopkode(30,stakpil+1,stakpil);
dandyopkode(29,stakpil+1,stakpil);
end;
zpil:=zpil+1;
att1(stakpil-2):=zpil;
end;
begin comment ----- whiledel ::= while -----;
att1(stakpil):=zpil+1;
end;
begin comment ----- fordel ::= for rex -----;
att1(stakpil-1):=att1(stakpil);
att2(stakpil-1):=att2(stakpil);
att3(stakpil-1):=zpil+1;
end;
begin comment gotosætn ::= goto navn -----;
o(13,0,1,0,0,0);
att1(stakpil-1):=zpil;
hoppil:=hoppil+1;
hoptab1(hoppil):=zpil;
hoptab2(hoppil):=idtabsøger(stakpil,1);
if idtab4(hoptab2(hoppil)) shift (-4) extract 4<>6 then
fejl(2021);
end;
begin comment ----- gotosætn ::= goto navn . navn -----;
att1(stakpil-3):=zpil;
if att1(stakpil-2)<>98 shift 16 or
att2(stakpil-2)+att3(stakpil-2)<>0 then fejl(2004);
i:=idtabsøger(stakpil,0);
if idtab4(i) shift (-4) extract 4<>6 then fejl(2021);
o(9,0,1,1,0,(basisref-zpil-1)*2);
o(13,0,1,0,0,idtab5(i)+2*(basisref-zpil-1));
att1(stakpil-3):=zpil;
end;
begin comment ----- gotosætn ::= gotohoved ) -----;
end;
begin comment ----- gotosætn ::= abled gotosætn -----;
if z(zbase+att1(stakpil)) shift (-18)<>13 then fejl(2004);
z(zbase+att1(stakpil)):=z(zbase+att1(stakpil))+att1(stakpil-1) shift 18;
end;
begin comment ----- gotohoved ::= goto rex of ( navn -----;
att1(stakpil-4):=zpil;
if att1(stakpil-3)<1 or att1(stakpil-3)>3 then fejl(2009);
o(9,0,0,0,att1(stakpil-3),0);
o(13,0,1,0,att1(stakpil-3),0);
att1(stakpil-4):=zpil;
o(13,0,1,0,0,0);
hoppil:=hoppil+1;
hoptab1(hoppil):=zpil;
hoptab2(hoppil):=idtabsøger(stakpil,1);
if idtab4(hoptab2(hoppil)) shift (-4) extract 4<>6 then
fejl(2021);
end;
begin comment ----- gotohoved ::= gotohoved , navn -----;
o(13,0,1,0,0,0);
hoppil:=hoppil+1;
hoptab1(hoppil):=zpil;
hoptab2(hoppil):=idtabsøger(stakpil,1);
if idtab4(hoptab2(hoppil)) shift (-4) extract 4<>6 then
fejl(2021);
end;
begin comment ----- assignment ::= operand := rex -----;
dandyopkode(15,stakpil,stakpil-2);
end;
begin comment ----- assignment ::= operand norm rex -----;
dandyopkode(28,stakpil,stakpil-2);
end;
begin comment ----- assignment ::= operand exch rex -----;
dandyopkode(13,stakpil,stakpil-2);
end;
begin comment ----- assignment ::= autoload operand -----;
att1(stakpil+1):=att2(stakpil+1):=0;
dandyopkode(27,stakpil+1,stakpil);
end;
begin comment ----- assignment ::= clear reserved with
operand -----;
if att1(stakpil-2)<>3 then fejl(2027);
att1(stakpil+1):=att2(stakpil+1):=0;
dandyopkode(26,stakpil+1,stakpil);
end;
begin comment ----- assignment ::= reserved := operand -----;
att1(stakpil+1):=att2(stakpil+1):=0;
if att1(stakpil-2)=3 then fejl(2027);
dandyopkode(18+att1(stakpil-2)-att1(stakpil-2)//4,
stakpil+1,stakpil);
end;
begin comment ----- assignment ::= operand := reserved -----;
att1(stakpil+1):=att2(stakpil+1):=0;
dandyopkode(21+att1(stakpil),stakpil+1,stakpil-2);
end;
begin comment ----- assignment ::= key ( operand )
:= rex -----;
if att2(stakpil-3) shift (-4)<>0 then fejl(2018) else
att2(stakpil-3):=0;
dandyopkode(18,stakpil,stakpil-3);
end;
begin comment ----- fpkald ::= fp ( pkonst ) -----;
if -, fp then fejl(2012);
if att3(stakpil-1)>95 then fejl(2028);
att1(stakpil-3):=hnavne(att3(stakpil-1));
end;
begin comment ----- fpkald ::= fp ( pkonst - pkonst ) -----;
if -, fp then fejl(2012);
if att3(stakpil-1)<>2 and att3(stakpil-1)<>4 then fejl(2028);
if att3(stakpil-3)>95 then fejl(2028);
att1(stakpil-5):=hnavne(att3(stakpil-3));
i:=att1(stakpil-5) shift (-14) extract 3;
if i=0 then fejl(2028);
if (att3(stakpil-1)=2 and i=2) or
(att3(stakpil-1)=4 and i=1) then fejl(2028);
att1(stakpil-5):=att1(stakpil-5)-att3(stakpil-1);
end;
begin comment ----- compkom ::= compord . binær -----;
if att1(stakpil-2) extract 6<>3 then fejl(2004);
if att1(stakpil)=2 then binær:=true else binær:=false;
case att1(stakpil-2) shift (-6) of
begin
begin
if (code and binær) or -,(code or binær) then else
begin
code:=binær;
if binær then
begin
if kodeudpil<5 then
begin
kodeudpil:=kodeudpil+1;
kodeud(1,kodeudpil):=zbase+zpil+1;
end;
end else
kodeud(2,kodeudpil):=zpil+zbase;
end;
att1(stakpil-2):=3;
end;
begin
fp:=binær;
if -, fp then
begin
reladr(2):=reladr(2)-1536;
blokstart:=blokstart-768;
fpplads:=0;
zbase:=zbase+768;
end;
att1(stakpil-2):=0;
end;
begin
list:=binær;
if list then write(out,false add 10,3);
att1(stakpil-2):=3;
end;
begin
mon:=binær;
att1(stakpil-0):=2;
end;
end;
end;
begin comment ----- compkom ::= compord pkonst -----;
if att1(stakpil-1) extract 6<> 1 then fejl(2004);
case att1(stakpil-1) shift (-6) of
begin
begin
if att3(stakpil)>2047 then fejl(2030);
if att3(stakpil) < testlimit then o(51,0,0,0,0,-att3(stakpil));
att1(stakpil-1):=2;
end;
begin
if att3(stakpil)>grenantal or att3(stakpil)<2 then fejl(2039);
o(11,0,0,0,0,3);
o(11,1,0,0,0,att3(stakpil)*2);
o(9,0,1,1,0,(basisref-zpil-1)*2);
o(13,3,1,0,0,vindhop+(basisref-zpil-1)*2);
att1(stakpil-1):=2;
end;
begin
if procantal>1 then fejl(2034);
procantal:=att3(stakpil);
reladr(2):=reladr(2)+2*procantal-2;
vindhop:=vindhop+2*procantal-2;
att1(stakpil-1):=0;
end;
begin
fejl(20);
if att3(stakpil)>grenantal or att3(stakpil)<2 then fejl(2039);
o(11,0,0,0,0,5);
o(11,1,0,0,0,att3(stakpil)*2);
o(9,0,1,1,0,2*(basisref-zpil-1));
o(13,3,1,0,0,vindhop+(basisref-zpil-1)*2);
att1(stakpil-1):=2;
end;
begin comment halt pkonst;
if att3(stakpil) > 1000 then fejl(2030);
o(14,0,0,0,0,-att3(stakpil));
att1(stakpil-1):=2;
end;
end;
end;
begin comment ----- compkom ::= compord pkonst , pkonst -----;
if att1(stakpil-3) extract 6<>2 then fejl(2004);
if grenantal=0 then
begin
grenantal:=att3(stakpil);
grenpil:=1;
knudeantal:=att3(stakpil-2);
i:=grenantal+knudeantal+38;
reladr(2):=reladr(2)+2*i;
vindhop:=reladr(2)-43;
att1(stakpil-3):=0;
end else
begin
procud(true);
if att3(stakpil-2)>knudeantal or att3(stakpil-2)<1 then fejl(2036);
i:=procantal+att3(stakpil-2);
if proctab(i)>0 then zpil:=proctab(i)//2-1 else
begin
if att3(stakpil-2)>knudepil+1 then fejl(2042) else if att3(stakpil-2)=knudepil+1 then knudepil:= knudepil+1;
proctab(i):=2*zpil+2;
end;
zbase:=-zpil;
if att3(stakpil)<>grenpil+1 then fejl(2038);
grenpil:=grenpil+1;
if grenpil>grenantal then fejl(2039);
i:=procantal+knudeantal+grenpil;
proctab(i):=att3(stakpil-2) shift 16 add filnr;
if grenpil>1 then
proctab(i-1):=proctab(i-1)+(filnr-proctab(i-1) extract
8) shift 9;
att1(stakpil-3):=1;
end;
end;
begin comment ----- kropstart3 ::= kropstart1 begin -----;
zpil:=zpil+1;
dynref:=-5000;
basisref:=zpil;
z(zbase+zpil):=-2*zpil;
if kropniv = 1 then fejl(14);
proctab(idtab4(att3(stakpil-1)) shift (-16)):=2*zpil+2;
end;
end;
stopsemantik: end semantik;
comment ********************************************************
behandling af syntaxfejl
********************************************************;
procedure fejl(fejlnr);
value fejlnr;
integer fejlnr;
begin
oklinie:=false;
fejlpil:=fejlpil+1;
fejlstak(1,fejlpil):=fejlnr;
fejlstak(2,fejlpil):=linienr;
if fejlpil=49 then fejl(2040);
if fejlnr=2040 then goto passstop;
end;
comment *******************************************************
udskrivning af genereret kode.
et 24-bits ord opfattes som:
1) et heltal
2) to bytes
3) tre karakterer
4) en maskinordre
*******************************************************;
procedure mnemoud(start,slut);
value start,slut;
integer start,slut;
begin
integer instr,reg,rel,indir,index,display,ordre;
integer array a(1:3);
write(out,false add 10,3,
<:proces- heltals- byte0 byte1 text objekt- maskine-ordre:>);
write(out,<:<10>:>,
<:adresse ord adresse<10><10>:>);
for i:=start step 1 until slut do
begin
ordre:=z(i);
instr:=ordre shift (-18);
reg:= ordre shift (-16) extract 2;
rel:=ordre shift (-15) extract 1;
indir:=ordre shift (-14) extract 1;
index:=ordre shift (-12) extract 2;
display:=ordre extract 11;
if (ordre shift (-11) extract 1) = 1 then display:=display-2048;
write(out,<:<10>:>,<<dddddd>,2*(i-zbase),<: :>);
write(out,<<-ddddddd>,ordre,<: :>);
write(out,<< -dddd>,extend(ordre shift (-12)),
extend(ordre extract 12),<: :>);
a(1):=ordre extract 8;
a(2):=ordre shift (-8) extract 8;
a(3):=ordre shift (-16);
for n:=1 step 1 until 3 do
outchar(out,if (a(4-n)>39 and a(4-n)<126) and
(a(4-n)<>64 and (a(4-n)<>94 and a(4-n)<>96))
then a(4-n) else 32);
if rel=1 then write(out,<: :>,<<-ddddd>,2*(i-zbase)+display,<: :>)
else write(out,<: :>);
write(out, case instr+1 of (
<:aw:>,<:io:>,<:bl:>,<:hl:>,<:la:>,<:lo:>,<:lx:>,<:wa:>,
<:ws:>,<:am:>,<:wm:>,<:al:>,<:ml:>,<:jl:>,<:jd:>,<:je:>,
<:xl:>,<:bs:>,<:ba:>,<:bz:>,<:rl:>,<:sp:>,<:kl:>,<:rs:>,
<:wd:>,<:rx:>,<:hs:>,<:xs:>,<:pl:>,<:ps:>,<:ms:>,<:is:>,
<:ci:>,<:ac:>,<:ns:>,<:nd:>,<:as:>,<:ad:>,<:ls:>,<:ld:>,
<:sh:>,<:sl:>,<:se:>,<:sn:>,<:so:>,<:sz:>,<:sx:>,<:ic:>,
<:fa:>,<:fs:>,<:fm:>,<:ks:>,<:fd:>,<:cf:>,<:dl:>,<:ds:>,
<:aa:>,<:ss:>,<:**:>,<:**:>,<:**:>,<:**:>,<:**:>,<:**:>));
if rel=1 then write(out,<:. :>) else write(out,<: :>);
write(out,case reg+1 of(<:w0:>,<:w1:>,<:w2:>,<:w3:>));
if indir=1 then write(out,<: (:>) else write(out,<: :>);
if index>0 then write(out,case index of(<:x1:>,<:x2:>,<:x3:>));
if index>0 then write(out,<<+d>,display)
else write(out,<<-d>,display);
if indir=1 then write(out,<:):>);
end;
write(out,false add 10,3);
end mnemoud;
comment *******************************************************
udskrivning af fejl detekteret ved oversættelsen
*******************************************************;
procedure fejlud;
begin
outchar(out,10); outchar(out,10);
for i:=1 step 1 until fejlpil do
begin
write(out,<:<10>line:>,<<ddddd>,fejlstak(2,i),<: *** :>);
if fejlstak(1,i)>2000 then
write(out,case fejlstak(1,i)-2000 of (
<:multiply declared:>,
<:operator illegal:>,
<:type illegal:>,
<:syntax:>,
<:name undeclared:>,
<:mode illegal:>,
<:text too long:>,
<:array overfilling:>,
<:index-register demanded:>,
<:register occupied:>,
<:type of fpname illegal:>,
<:no access to fp:>,
<:no access to monitor:>,
<:monitor-call illegal:>,
<:register-type illegal:>,
<:register illegal:>,
<:delimiter illegal:>,
<:constant not allowed as an operand:>,
<:operand illegal:>,
<:number of part too large:>,
<:kind of name illegal:>,
<:compiler-word illegal:>,
<:parameter-fault:>,
<:link-register illegal:>,
<:parameter-types do not fit:>,
<:relational operator illegal:>,
<:special-register illegal:>,
<:fp-call illegal:>,
<:too many end's:>,
<:constant too large:>,
<:rounding error at fraction:>,
<:section too long:>,
<:adressing not possible:>,
<:multiple statement:>,
<:too many procedures:>,
<:node undefined:>,
<:conflict - autotape<>branching:>,
<:continuus branch-numbering demanded:>,
<:branch undefined:>,
<:compilation stopped:>,
<:array-bounds illegal:>,
<:continuus node-numbering demanded:>)) else
write(out,<:syntax - illegal symbol :>,
case fejlstak(1,i) of (
<:(:>,<:):>,<:,:>,<:-:>,<:.:>,<:::>,<::=:>,<:;:>,
<:dis/enabled:>,<:inout:>,<:address:>,<:array:>,
<:autoload:>,<:begin:>,<:yes/no:>,<:body:>,<:call:>,
<:case:>,<:clear:>,<:'compiler-word':>,<:create:>,
<:do:>,<:downto:>,<:dyadic oper.:>,<:else:>,<:end:>,
<:for:>,<:fp:>,<:getchar:>,<:goto:>,<:if:>,<:key:>,
<:label:>,<:layout:>,<:dynamic/incode:>,<:monitor:>,
<:monadic oper.:>,<:'name':>,<:norm:>,<:of:>,
<:'constant':>,<:procedure:>,<:record:>,<:'register':>,
<:relational oper.:>,<:spec. register:>,<:step:>,
<:'string':>,<:text:>,<:then:>,<:'type':>,<:upto:>,
<:while:>,<:with:>,<:write:>,<:exch:>,<:'constant':>));
end;
end fejlud;
comment *******************************************************
udskrivning af fejl ved forbindelse af ind/ud-filer
*******************************************************;
procedure confejl(fejlnr);
value fejlnr;
integer fejlnr;
begin
write(out,<:<10><10>connectfejl *** :>,
case fejlnr of (
<:objectfile missing:>,
<:objectfile not on bs.:>,
<:connection impossible:>,
<:external process not bs-process:>,
<:creation impossibble:>));
goto stop;
end confejl;
comment *********************************************************
input- og outputfil forbindes med oversætter
*********************************************************;
if system(4,1,arr)<>6 shift 12+10 then
begin
objectfile:=false;
open(save,4,<::>,0);
end else
begin
objectfile:=true;
system(4,0,arr);
i:=1;
open(save,4,string arr(increase(i)),0);
end;
outchar(out,10);
if system(4,if objectfile then 3 else 2,arr) <> 4 shift 12 + 10
and system(4,if objectfile then 2 else 1,arr) <> 4 shift 12 + 10
then write(out,<:c:>) else
for i:=0 step 1 until 10 do
outchar(out,arr(i//6+1) shift (-40+(i mod 6)*8) extract 8);
begin
real clock;
monitor(42,in,0,tail);
clock:=tail(6);
if clock > 4000000 then
begin
clock:=clock*2**19/10000;
write(out,<: d.:>,<<dddddd>,systime(4,clock,time),<:.:>,<<zddd>,time/100);
end;
outchar(out,10);
end;
if monitor(42,save,0,tail)<>0 then
begin
create:
tail(1):=1;
for i:=2 step 1 until 10 do tail(i):=0;
if monitor(40,save,0,tail)<>0 then confejl(5);
end;
if tail(1)<0 then
begin
if tail(1)<>1 shift 23+4 then confejl(2);
close(save,false);
i:=1;
laf:=2;
open(save,4,string tail.laf(increase(i)),1);
end;
if monitor(52,save,0,tail)+monitor(8,save,0,tail)<>0 then goto create;
system(5,monitor(4,save,0,tail),tail);
if tail(1)<>4 then confejl(4);
comment *********************************************************
initialiseringer
*********************************************************;
comment *** tilstands/aktionstabeller ***;
for i:=1 step 1 until 8 do
begin
for j:=2 step 1 until 8 do
begin
aktion(i,j):=case 7*(i-1)+j-1 of
( 1, 8, 10, 10, 6, 8, 21,
2, 13, 3, 13, 13, 13, 20,
4, 14, 14, 14, 14, 14, 14,
5, 15, 15, 15, 15, 15, 15,
16, 11, 16, 16, 16, 16, 16,
7, 17, 17, 17, 7, 17, 17,
18, 18, 18, 18, 9, 12, 18,
19, 19, 19, 19, 7, 19, 19 );
tilst(i,j):=case 7*(i-1)+j-1 of
( 2, 5, 4, 1, 6, 7, 1,
2, 1, 3, 1, 1, 1, 2,
3, 1, 1, 1, 1, 1, 1,
3, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1,
6, 1, 1, 1, 6, 1, 1,
1, 1, 1, 1, 8, 1, 1,
1, 1, 1, 1, 8, 1, 1 );
end;
end;
comment *** tabeller over dobbeltskilletegn ***;
for i:=1 step 1 until 7 do
begin
toskil1(i):=case i of
( 3816704, 3092224, 3947776, 4078848, 3948032, 3095808, 2899200 );
toskil2(i):=case i of
( 7, 408, 493, 557, 301, 664, 600);
end;
comment *** tabeller over reserverede navne ***;
for i:=1 step 1 until 82 do
begin
navnetab1(i):=case i of (
6382692, 6385252, 6386290, 6386536, 6387060
, 6448487, 6451044, 6453620, 6513004, 6513011
, 6515813, 6517349, 6580595, 6582016, 6582133
, 6582135, 6584686, 6646899, 6647393, 6647396
, 6649856, 6649955, 6649972, 6696960, 6697216
, 6697472, 6697728, 6712431, 6713202, 6713344
, 6776180, 6778740, 6907392, 6909539, 6909551
, 6909556, 7038329, 7102818, 7102841, 7107432
, 7168371, 7171940, 7171950, 7237376, 7237490
, 7300608, 7302757, 7303680, 7369327, 7369332
, 7497057, 7497059, 7497062, 7499637, 7566437
, 7628152, 7628901, 7696500, 7811072, 7811328
, 7811584, 7811840, 7825513, 7825780, 7827314
, 7828073, 7892850, 7955827, 8021362, 6387060
, 6451809, 6516580, 6713344, 6776180, 6840684, 7103854
, 7104883, 7171950, 7368563, 7561590, 7562595
, 7628147);
navnetab2(i):=case i of (
7497075, 0, 6387968, 6907508, 7302255
, 6909440, 7929856, 6619136, 7077888, 6619136
, 6386176, 6386789, 6382188, 0, 6450277
, 7238767, 6385001, 6619136, 6450277, 0
, 0, 6815744, 7496035, 0, 0
, 0, 0, 6386688, 0, 0
, 6514785, 7274496, 0, 7300197, 7697408
, 7471104, 0, 6646784, 7304564, 6907508
, 7012352, 0, 6911087, 0, 7143424
, 0, 7168371, 0, 6514020, 0
, 7077888, 7303780, 0, 7234560, 7340032
, 7602176, 7208960, 7274496, 0, 0
, 0, 0, 7103744, 6815744, 6553600
, 7628032, 0, 0, 7302497, 7304289
, 7234408, 6619136, 0, 0, 7602176, 6780008
, 7602176, 6911087, 6911081, 6619136, 7629167
, 7602176);
navnetab3(i):=case i of (
7536640, 0, 0, 0, 6382592
, 0, 0, 0, 0, 0
, 0, 0, 6644736, 0, 0
, 0, 6488064, 0, 6553600, 0
, 0, 0, 7602176, 0, 0
, 0, 0, 0, 0, 0
, 7471104, 0, 0, 0, 0
, 0, 0, 0, 0, 0
, 0, 0, 7471104, 0, 0
, 0, 7012352, 0, 7696997, 0
, 0, 0, 0, 0, 0
, 0, 0, 0, 0, 0
, 0, 0, 0, 0, 0
, 0, 0, 0, 7564032, 7365888
, 0, 0, 0, 0, 0, 0
, 0, 7471104, 7302656, 0, 7238400
, 0);
navnetab4(i):=case i of (
11, 728, 12, 792, 13
, 14, 16, 115, 17, 18
, 19, 21, 73, 22, 371
, 23, 227, 25, 137, 26
, 174, 56, 856, 300, 364
, 428, 492, 165, 27, 28
, 29, 30, 31, 163, 10
, 238, 32, 33, 34, 8984
, 302, 472, 36, 79, 39
, 40, 365, 4824, 42, 110
, 307, 43, 179, 101, 47
, 49, 50, 52, 44, 108
, 172, 236, 53, 54, 243
, 55, 8920, 143, 429, 4180
, 4244, 4308, 8404, 8276, 20564, 4372
, 12500, 16596, 8468, 16468, 12372
, 4180);
end;
comment *** fp-værdier (hnavne) ***;
for i:=0 step 1 until 99 do hnavne(i):=case i+1 of (
12252, 12262, 12280, 12288, 12296
, 12338, 12312, 4144, 8284, 8282
, 8194, 1334, 0, 512, 5424
, 8300, 8302, 24690, 78, 8478
, 8552, 8602, 21002, 4634, 54690
, 21328, 21372, 21944, 5566, 38270
, 38290, 21494, 21528, 21418, 5058
, 5382, 4752, 462, 1358, 934
, 9320, 1154, 1148, 1194, 9330
, 1162, 1170, 1150, 53822, 1156
, 100, 12386, 118, 250, 8684
, 13824, 1024, 0, 8436, 932
, 1218, 1216, 1214, 1212, 1210
, 32, 8668, 5422, 4140, 1250
, 1234, 1232, 1230, 1228, 1226
, 1224, 0, 1222, 1220, 54726
, 8492, 9676, 9700, 88, 430
, 1186, 766, 638, 774, 1368
, 1, 1, 280, 354, 404
, 4220, 96, 97, 98, 11);
comment *** tabel over skilletegn ***;
for i:=40 step 1 until 62 do skiltab(i):=case i-39 of
( 1, 2, 280, 0, 3, 0, 0, 344, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 6, 8, 173, 237, 109);
comment *** tabel over type-operator-kombinationer og til-
hørende maskinordrer ***;
for i:=1 step 1 until 146 do dyoptab(i):=case i of (
263424, 266392, 271632, 275736, 478624,
482728, 486832, 524760, 529560, 532944,
537048, 595088, 598480, 602576, 623064,
627864, 635352, 674848, 683040, 712232,
716328, 740384, 745000, 748576, 786968,
791640, 795152, 799256, 857168, 860688,
864784, 885272, 889944, 897560, 937056,
945248, 974440, 978536, 1002592, 1007208,
1010784, 1049256, 1061544, 1147560, 1159848,
1199264, 1207456, 1264800, 1272992, 1461536,
1469728, 1527072, 1535264, 1738264, 1750552,
1771032, 1783320, 2285096, 2289192, 2317864,
2321960, 2364632, 2625752, 2883864, 2896152,
2982168, 2994456, 3148057, 3152153, 3160345,
3246361, 3250457, 3258649, 3311977, 3316073,
3324265, 3344745, 3348841, 3357033, 3409472,
3417680, 3421784, 3475008, 3483216, 3507776,
3520088, 3674832, 3678928, 3683024, 3687120,
3691216, 3699408, 3937920, 3941824, 3945920,
4007376, 4036248, 4044248, 4083168, 4120040,
4148720, 4152816, 4196865, 4200961, 4205057,
4209153, 4262417, 4266513, 4270609, 4274705,
4295193, 4299289, 4303385, 4307481, 4457880,
4721856, 4820184, 4986624, 5248000, 5518080,
5773120, 6035136, 6305728, 6567808, 6822849,
6831041, 7086080, 7090176, 7346328, 7411864,
7444632, 7477480, 7510248, 7543016, 7609217,
7617409, 7869760, 7873856, 7877952, 7882048,
7886144, 8135489, -8384447, -8376255, -8286143,
-8277951);
comment *** tabel for opslag i type-operatortabel ***;
for i:=1 step 1 until 32 do dyopslag(i):=case i of
(4, 14, 27, 37, 43, 47, 47, 51, 54, 55, 57, 65, 75, 81, 89,
99,106,107,109,110,111,112,113,114,115,116,118,122,126,130,
138,140);
comment *** enkelt-initialiseringer ***;
fpplads:=1536;
oklinie:=true;
testlimit:=0;
outchar(out,10);
for i:=1 step 1 until 1300 do z(i):=0;
maxadresse:=0;
forudsymbol:=1;
afbryd1:=afbryd2:=afbryd3:=afbryd4:=afbryd5:=false;
kodeudpil:=0;
konstpil1:=0;
konstpil2:=-1;
vindhop:=0;
recovpoint:=1;
blokdybde:=0;
kropniv:=0;
fejlpil:=0;
modedybde:=1;
liniepil:=0;
klasse:=5;
linienr:=1;
for i:=1 step 1 until 10 do tail(i):=0;
beginniv:=endniv:=45;
autotape:=0;
grenantal:=knudeantal:=0;
grenpil:=knudepil:=0;
reladr(2):=1537;
reladr(3):=-1;
hoppil:=0;
procantal:=1;
blokstart:=768;
procnr:=1;
for i:=1 step 1 until 80 do linie(i):=32;
for i:=2 step 1 until 256 do proctab(i):=0;
layoutord:=1 shift 11 add 32 shift 12 add 5;
zpil:=768;
zbase:=-767;
kodeaddr:=2*zpil;
casestakpil:=0;
filnr:=0;
idtab1(1):=98 shift 16;
idtab1(2):=100 shift 16;
idtab2(1):=idtab3(1):=idtab4(1):=idtab5(1):=0;
idtab2(2):=idtab3(2):=idtab4(2):=idtab5(2):=0;
idtabpil:=curridlimit:=2;
hptop:=2;
stakpil:=0;
fi:=0;
list:=errorlist:=code:=xref:=false;
item:=if objectfile then 2 else 1;
for item:=item+1 while system(4,item,arr)=4 shift 12+10 do
begin
if arr(1)=real(<:list:>) then
begin
item:=item+1;
if system(4,item,arr) = 8 shift 12+10 then
begin
if arr(1) = real <:yes:> then list:=true else
if arr(1) = real <:error:> then errorlist:=true;
end;
end else
if arr(1) = real <:xref:> then
begin
item:=item+1;
if system(4,item,arr) = 8 shift 12+10 and arr(1) = real <:yes:> then
begin
xref:=true;
open(zxref,4,<::>,0);
tail(1):=1;
for i:=2 step 1 until 10 do tail(i):=0;
if monitor(40,zxref,0,tail) <> 0 then confejl(5);
if monitor(52,zxref,0,tail)+monitor(8,zxref,0,tail) <> 0 then
confejl(3);
end;
end else
if arr(1) = real <:test:> then
begin
testlimit:=2048;
item:=item+1;
if system(4,item,arr) = 8 shift 12 + 10 then testlimit:=arr(1);
end;
;
end;
fp:=mon:=true;
cpu:=systime(1,0,time);
comment *********************************************************
kald af analysator (start af oversættelse)
*********************************************************;
parser(semantik,staksemantik,fejl,100,næstesymbol);
passstop:
if xref then
begin
outrec6(zxref,8);
zxref.if2:=127 shift 16;
close(zxref,false);
end;
cpu:=systime(1,time,time)-cpu;
comment *** udskrivning af compilermeddelelser ***;
systime(1,0,time);
write(out,<:<10><10>rcmol/:>,<<zdd>,versionid,<: d.:>,<<dddddd>,
systime(4,time,rkonst),<:.:>,<<zddd>,rkonst/100);
write(out,<:<10>translation time =:>,<<dddd.dd>,cpu,<: sec:>);
if fejlpil>0 then
begin comment *** fejludskrivning ***;
fejlud;
outchar(out,10);
end else
begin comment *** udskrivning af programmets pladskrav ***;
write(out,<:<10>core area claim = :>,<<dddddd>,
(if grenantal>0 then maxadresse else 2*zpil)-fpplads,
<: bytes:>);
write(out,<:<10>disc area claim = :>,<<dddddd>,
filnr,<: segments<10>:>);
comment *** indsættelse af administrationen på 1. segment ***;
setposition(save,0,0);
proctab(1):=maxadresse*2;
swoprec(save,128);
system(4,0,arr);
comment *** procedureindhopsadresser og
lagervekslingsknudernes adresser indsættes ***;
for i:=1 step 1 until procantal+knudeantal do
save.fi(i):=proctab(i)-maxadresse;
if grenantal>0 then
begin
n:=procantal+knudeantal+grenpil;
proctab(n):=proctab(n)+(filnr-proctab(n) extract 8) shift 9;
comment *** grentabellen indsættes ***;
for i:=procantal+knudeantal+1 step 1 until procantal+
knudeantal+grenantal do save.fi(i):=proctab(i);
comment *** lagervekslingsrutine indsættes ***;
for n:=i step 1 until i+37 do save.fi(n):=case n-i+1 of(
arr.fi(1), arr.fi(2), arr.fi(3), arr.fi(4), 0,
0, 0, 0, 0, 0, 0, 0, 0,
127*512, 255, 0,
6262782,
5349340-2*grenantal,
5373954,-6680591,
5418966-2*(grenantal+knudeantal),
6197218, 5373954, 1216492, 2002908, 6197212,
5373954, 1216486, 6197208,-6815732, 6066126,
2985932, 3116992, 3672080, 2985926, 3672082,
1314816, 3461076);
end;
comment *** indsættelse af filbeskrivelse (entry tail) ***;
tail(1):=filnr;
systime(1,0,time);
hkonst:=time*10000;
tail(6):=hkonst shift (-19) extract 24;
tail(9):=(if fp then 2 else 3) shift 12 + indhop;
tail(10):=if grenpil>0 then proctab(procantal+knudeantal+1)
shift 8 shift (-16) shift 8 else filnr shift 9;
monitor(44,save,0,tail);
close(save,true);
if system(4,1,arr)<>6 shift 12 + 10 then monitor(48,save,0,tail);
end;
end;
if -, xref then goto stop;
begin
long field msp;
integer currno,sections,sectioncount;
long maxvalue,currmsp,currlsp;
integer array zia(1:20);
long array workname(1:2);
procedure eof(z,s,b);
zone z;
integer s,b;
begin
s:=0;
b:=sections*512;
end eof;
sections:=40;
msp:=4;
maxvalue:=127; maxvalue:=maxvalue shift 40;
currmsp:=maxvalue;
getzone6(zxref,zia);
workname(1):=zia(2);
workname(1):=workname(1) shift 24 add zia(3);
workname(2):=zia(4);
workname(2):=workname(2) shift 24 add zia(5);
write(out,<:<12><10>rcmol cross references:<10><10>:>);
begin
zone z(sections*128,1,eof);
integer i,max,file,block;
procedure sort(z,max);
zone z;
integer max;
begin
integer i,j,k,m;
long msp1,lsp1,msp2,lsp2;
swoprec(z,2*max);
for i:=1 step i until max do m:=2*i-1;
for m:=m//2 while m > 0 do
begin
k:=max-m;
for j:=1 step 1 until k do
begin
for i:=j step -m until 1 do
begin
msp1:=long z(2*i-1); lsp1:=long z(2*i);
msp2:=long z(2*(i+m)-1); lsp2:=long z(2*(i+m));
if msp2 > msp1 or (msp2 = msp1 and lsp2 > lsp1) then goto nextj;
z(2*i-1):=real msp2; z(2*i):=real lsp2;
z(2*(i+m)-1):=real msp1; z(2*(i+m)):=real lsp1;
end i;
nextj:
end j;
end m;
end sort;
i:=1;
open(z,4,string workname(increase(i)),1 shift 18);
block:=sectioncount:=0;
max:=sections*64;
for i:=i while max = sections*64 do
begin
setposition(z,0,block);
i:=0;
for i:=i+1 while i <= max do
begin
inrec6(z,8);
if z.msp >= maxvalue then max:=i-1;
end;
setposition(z,0,block);
sort(z,max);
sectioncount:=sectioncount+1;
block:=block+sections;
end;
close(z,false);
end;
begin
zone array z(sections,128,1,eof);
integer array rest(1:sections);
long array arr(1:2);
integer i,j,bestzone;
boolean procedure next(arr);
long array arr;
begin
integer i,bestzone;
long field msp,lsp;
msp:=4; lsp:=8;
bestzone:=-1;
arr(1):=maxvalue;
arr(2):=0;
for i:=1 step 1 until sectioncount do
begin
if rest(i) > 0 then
begin
if z(i).msp < arr(1) or (z(i).msp = arr(1) and z(i).lsp < arr(2)) then
begin
arr(1):=z(i).msp;
arr(2):=z(i).lsp;
bestzone:=i;
end;
end;
end i;
if bestzone < 1 then next:=false else
begin
next:=true;
rest(bestzone):=rest(bestzone)-1;
inrec6(z(bestzone),8);
end;
end next;
procedure display(arr);
long array arr;
begin
integer i,char;
if currmsp <> arr(1) or currlsp shift (-24) <> arr(2) shift (-24) then
begin
outchar(out,10);
for i:=0 step 1 until 8 do
begin
char:=arr(i//6+1) shift (-40+(i mod 6)*8) extract 8;
if char = 0 then char:=32;
outchar(out,char);
end;
currmsp:=arr(1);
currlsp:=arr(2);
currno:=1;
write(out,<<dddddd>,currlsp extract 20,
false add (if currlsp shift (-20) extract 1 = 1 then
32 else 42),1);
end else
begin
if currno mod 10 = 0 then write(out,false add 10,1,false add 32,9);
currno:=currno+1;
write(out,<<dddddd>,arr(2) extract 20,false add (if arr(2) shift (-20)
extract 1 = 1 then 32 else 42),1);
end;
end display;
for i:=1 step 1 until sectioncount do
begin
j:=1;
open(z(i),4,string workname(increase(j)),1 shift 18);
setposition(z(i),0,sections*(i-1));
inrec6(z(i),8);
rest(i):=sections*64;
end;
for i:=i while next(arr) do display(arr);
for i:=1 step 1 until sectioncount do close(z(i),true);
monitor(48,zxref,0,zia);
end;
end;
stop:
end
end
▶EOF◀