📄 x.txt
字号:
Error(11);
If sy = lparent Then
insymbol
End ;
tp := arrays;
arraytyp(rf,sz)
End
Else
Begin (*records*) insymbol;
enterblock; tp := records; rf := b;
If level = lmax Then fatal(5);
level := level+1; display[level] := b; offset := 0;
While sy <> endsy do
Begin (*field section*)
If sy = ident Then
Begin t0 := t; entervariable;
While sy = comma do
Begin insymbol; entervariable
End ;
If sy = colon Then insymbol Else Error(5);
t1 := t;
typ(fsys+[semicolon,endsy,comma,ident],
eltp,elrf,elsz);
While t0 < t1 do
Begin t0 := t0 + 1;
with tab[t0] do
Begin typ:=eltp; ref := elrf; normal := true;
adr := offset; offset := offset + elsz
End
End
End ;
If sy <> endsy Then
Begin If sy = semicolon Then insymbol Else
Begin Error(14);
If sy = comma Then insymbol
End ;
test([ident,endsy,semicolon], fsys, 6)
End
End ;
btab[rf].vsize := offset; sz := offset;
btab[rf].psize := 0; insymbol; level := level-1
End ;
test(fsys, [], 6)
End
End (*typ*);
Procedure parameterlist; (*formal parameter list*)
var
tp: types;
rf, sz, x, t0: integer;
valpar: boolean;
Begin
insymbol;
tp := notyp;
rf := 0;
sz := 0;
test([ident,varsy], fsys+[rparent], 7);
While sy in [ident,varsy] do
Begin
If sy <> varsy Then
valpar := true
Else
Begin
insymbol;
valpar := false
End ;
t0 := t;
entervariable;
While sy = comma do
Begin
insymbol;
entervariable;
End ;
If sy = colon Then
Begin
insymbol;
If sy <> ident Then
Error(2)
Else
Begin
x := loc(id);
insymbol;
If x <> 0 Then
with tab[x] do
If obj <> type1 Then
Error(29)
Else
Begin tp := typ; rf := ref;
If valpar Then sz := adr Else sz := 1
End
End ;
test([semicolon,rparent], [comma,ident]+fsys, 14)
End
Else
Error(5);
While t0 < t do
Begin
t0 := t0+1;
with tab[t0] do
Begin typ := tp; ref := rf;
normal := valpar; adr := dx; lev := level;
dx := dx + sz
End
End ;
If sy <> rparent Then
Begin
If sy = semicolon Then
insymbol
Else
Begin
Error(14);
If sy = comma Then
insymbol
End ;
test([ident,varsy], [rparent]+fsys, 6)
End
End (*While*) ;
If sy = rparent Then
Begin
insymbol;
test([semicolon,colon], fsys, 6)
End
Else
Error(4)
End (*parameterlist*) ;
Procedure constantdeclaration;
var
c: conrec;
Begin
insymbol;
test([ident], blockbegsys, 2);
While sy = ident do
Begin
enter(id,konstant);
insymbol;
If sy = eql Then
insymbol
Else
Begin
Error(16);
If sy = becomes Then
insymbol
End;
constant([semicolon,comma,ident]+fsys,c);
tab[t].typ := c.tp;
tab[t].ref := 0;
If c.tp = reals Then
Begin
enterreal(c.r);
tab[t].adr := c1
End
Else
tab[t].adr := c.i;
testsemicolon
End
End (*constantdeclaration*) ;
Procedure typedeclaration;
var
tp: types; rf, sz, t1: integer;
Begin
insymbol;
test([ident], blockbegsys, 2);
While sy = ident do
Begin
enter(id,type1);
t1 := t;
insymbol;
If sy = eql Then
insymbol
Else
Begin
Error(16);
If sy = becomes Then
insymbol
End ;
typ([semicolon,comma,ident]+fsys, tp, rf, sz);
with tab[t1] do
Begin
typ := tp;
ref := rf;
adr := sz
End ;
testsemicolon
End
End (*typedeclaration*) ;
Procedure variabledeclaration;
var
t0, t1, rf, sz: integer;
tp: types;
Begin insymbol;
While sy = ident do
Begin t0 := t; entervariable;
While sy = comma do
Begin insymbol; entervariable;
End ;
If sy = colon Then insymbol Else Error(5);
t1 := t;
typ([semicolon,comma,ident]+fsys, tp, rf, sz);
While t0 < t1 do
Begin t0 := t0+1;
with tab[t0] do
Begin typ := tp; ref := rf;
lev := level; adr := dx; normal := true;
dx := dx + sz
End
End ;
testsemicolon
End
End (*variabledeclaration*) ;
Procedure procdeclaration;
var
isfun: boolean;
Begin
isfun := sy = functionsy;
insymbol;
If sy <> ident Then
Begin
Error(2);
id := ' ';
End;
If isfun Then
enter(id,funktion)
Else
enter(id,prozedure);
tab[t].normal := true;
insymbol;
block([semicolon]+fsys, isfun, level+1);
If sy = semicolon Then
insymbol
Else
Error(14);
emit(32+ord(isfun)) (*exit*)
End (*procdeclaration*) ;
Procedure statement(fsys: symset);
var
i: integer;
x: item;
Procedure expression(fsys: symset; var x: item); forward;
Procedure selector(fsys: symset; var v: item);
var
x: item;
a,j: integer;
Begin (*sy in [lparent, lbrack, period]*)
Repeat
If sy = period Then
Begin insymbol; (*field selector*)
If sy <> ident Then
Error(2)
Else
Begin
If v.typ <> records Then
Error(31)
Else
Begin (*search field identifier*)
j := btab[v.ref].last;
tab[0].name := id;
While tab[j].name <> id do
j := tab[j].link;
If j = 0 Then
Error(0);
v.typ := tab[j].typ;
v.ref := tab[j].ref;
a := tab[j].adr;
If a <> 0 Then
emit1(9,a)
End ;
insymbol
End
End
Else
Begin (*array selector*)
If sy <> lbrack Then
Error(11);
Repeat
insymbol;
expression(fsys+[comma,rbrack], x);
If v.typ <> arrays Then
Error(28)
Else
Begin
a := v.ref;
If atab[a].inxtyp <> x.typ Then
Error(26)
Else
If atab[a].elsize = 1 Then
emit1(20,a)
Else
emit1(21,a);
v.typ := atab[a].eltyp; v.ref := atab[a].elref;
End
until sy <> comma;
If sy = rbrack Then
insymbol
Else
Begin
Error(12);
If sy = rparent Then
insymbol
End
End
until not (sy in [lbrack,lparent,period]);
test(fsys, [], 6)
End (*selector*) ;
Procedure call(fsys: symset; i: integer);
var
x: item;
lastp, cp, k: integer;
Begin emit1(18,i); (*mark stack*)
lastp := btab[tab[i].ref].lastpar; cp := i;
If sy = lparent Then
Begin (*actual parameter list*)
Repeat insymbol;
If cp >= lastp Then
Error(39)
Else
Begin cp := cp+1;
If tab[cp].normal Then
Begin (*value parameter*)
expression(fsys+[comma,colon,rparent], x);
If x.typ=tab[cp].typ Then
Begin
If x.ref <> tab[cp].ref Then Error(36) Else
If x.typ = arrays Then emit1(22,atab[x.ref].size) Else
If x.typ = records Then emit1(22,btab[x.ref].vsize)
End Else
If (x.typ=ints) and (tab[cp].typ=reals) Then
emit1(26,0) Else
If x.typ<>notyp Then Error(36);
End Else
Begin (*variable parameter*)
If sy <> ident Then Error(2) Else
Begin k := loc(id); insymbol;
If k <> 0 Then
Begin If tab[k].obj <> variable Then Error(37);
x.typ := tab[k].typ; x.ref := tab[k].ref;
If tab[k].normal
Then emit2(0,tab[k].lev,tab[k].adr)
Else emit2(1,tab[k].lev,tab[k].adr);
If sy in [lbrack,lparent,period] Then
selector(fsys+[comma,colon,rparent], x);
If (x.typ<>tab[cp].typ) or (x.ref<>tab[cp].ref)
Then Error(36)
End
End
End
End ;
test([comma,rparent], fsys, 6)
until sy <> comma;
If sy = rparent Then insymbol Else Error(4)
End ;
If cp < lastp Then Error(39); (*too few actual parameters*)
emit1(19, btab[tab[i].ref].psize-1);
If tab[i].lev < level Then emit2(3, tab[i].lev, level)
End (*call*) ;
Function resulttype(a,b: types): types;
Begin
If (a>reals) or (b>reals) Then
Begin
Error(33);
resulttype := notyp
End
Else
If (a=notyp) or (b=notyp) Then
resulttype := notyp
Else
If a=ints Then
If b=ints Then
resulttype := ints
Else
Begin
resulttype := reals;
emit1(26,1)
End
Else
Begin
resulttype := reals;
If b=ints Then
emit1(26,0)
End
End (*resulttype*) ;
Procedure expression;
var
y:item;
op:symbol;
Procedure simpleexpression(fsys: symset; var x: item);
var y:item; op:symbol;
Procedure term(fsys:symset; var x:item);
var y:item; op:symbol; ts:typset;
Procedure factor(fsys:symset; var x: item);
var i,f: integer;
Procedure standfct(n: integer);
var ts: typset;
Begin (*standard function no. n*)
If sy = lparent Then
insymbol
Else
Error(9);
If n < 17 Then
Begin
expression(fsys+[rparent],x);
case n of
(*abs,sqr*) 0,2: Begin ts := [ints,reals];
tab[i].typ := x.typ;
If x.typ = reals Then n:=n+1
End;
(*odd,chr*) 4,5: ts := [ints];
(*ord*) 6: ts := [ints,bools,chars];
(*succ,pred*) 7,8: ts := [chars];
(*round,trunc*) 9,10,11,12,13,14,15,16:
(*sin,cos,...*) Begin ts := [ints,reals];
If x.typ = ints Then emit1(26,0)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -