📄 ucscompiler.pas
字号:
end else begin {op in [idiv,imod]}
if (x.typ=ints) and(y.typ=ints)
then if op=idiv
then emit(58)
else emit(59)
else begin
if(x.typ<>notyp) and(y.typ<>notyp)
then CCLex.error(34);
x.typ:= notyp
end
end
end//while
end;{term }
begin { simpleexpression }
if sy in [plus,minus]
then begin
op:= sy;
CCLex.Insymbol;
term(fsys+[plus,minus],x);
if x.typ > reals
then CCLex.error(33)
else if op = minus
then emit(36)
end else term(fsys+[plus,minus,orsy],x);
while sy in [plus,minus,orsy] do
begin
op:= sy;
CCLex.Insymbol;
term(fsys+[plus,minus,orsy],y);
if op = orsy
then begin
if (x.typ=bools) and (y.typ=bools)
then emit(51)
else begin
if(x.typ<>notyp) and (y.typ<>notyp)
then CCLex.error(32);
x.typ:= notyp
end
end else begin
x.typ:= resulttype(x.typ,y.typ);
case x.typ of
notyp: ;
ints: if op = plus
then emit(52)
else emit(53);
reals: if op = plus
then emit(54)
else emit(55)
end {case}
end
end{while}
end; {simpleexpression}
begin {expression}
simpleexpression(fsys+[eql,neq,lss,leq,gtr,geq],x);
if sy in [eql,neq,lss,leq,gtr,geq]
then begin
op:= sy;
CCLex.Insymbol;
simpleexpression(fsys,y);
if (x.typ in [notyp,ints,bools,chars]) and (x.typ=y.typ)
then case op of
eql: emit(45);
neq: emit(46);
lss: emit(47);
leq: emit(48);
gtr: emit(49);
geq: emit(50);
end
else begin
if x.typ = ints
then begin
x.typ:= reals;
emit1(26,1)
end else if y.typ=ints
then begin
y.typ:= reals;
emit1(26,0)
end;
if (x.typ=reals) and (y.typ= reals)
then case op of
eql: emit(39);
neq: emit(40);
lss: emit(41);
leq: emit(42);
gtr: emit(43);
geq: emit(44);
end
else CCLex.error(35)
end;
x.typ:= bools
end
end ;{expression}
procedure assignment(lv,ad: integer);
var x,y: item;
f: integer;
begin { tab[i].obj in [variable,prosedure]}
x.typ:= tab[i].typ;
x.ref:= tab[i].ref;
if tab[i].normal then f:= 0 else f:= 1;
emit2(f,lv,ad);
if sy in [lbrack,lparent,period]
then selector([becomes,eql]+fsys,x);
if sy = becomes
then CCLex.Insymbol
else begin
CCLex.error(51);
if sy= eql then CCLex.Insymbol
end;
expression(fsys,y);
if x.typ=y.typ
then if x.typ in stantyps
then emit(38)
else if x.ref <> y.ref
then CCLex.error(46)
else if x.typ=arrays
then emit1(23,atab[x.ref].size)
else emit1(23,btab[x.ref].vsize)
else if (x.typ=reals) and(y.typ=ints)
then begin
emit1(26,0);
emit(38)
end else if (x.typ<>notyp) and (y.typ<>notyp)
then CCLex.error(46)
end ;{assignment}
procedure compoundstatement;
begin
CCLex.Insymbol;
statement([semicolon,endsy]+fsys);
while sy in [semicolon]+statbegsys do
begin
if sy = semicolon
then CCLex.Insymbol
else CCLex.error(14);
statement([semicolon,endsy]+fsys)
end;
if sy = endsy then CCLex.Insymbol else CCLex.error(57)
end ; {compundstatement}
procedure ifstatement;
var x : item;
lc1,lc2: integer;
begin
CCLex.Insymbol;
expression(fsys+[thensy,dosy],x);
if not (x.typ in [bools,notyp])
then CCLex.error(17);
lc1:= lc;
emit(11); {jmpc}
if sy = thensy
then CCLex.Insymbol
else begin
CCLex.error(52);
if sy = dosy
then CCLex.Insymbol
end;
statement(fsys+[elsesy]);
if sy = elsesy
then begin
CCLex.Insymbol; lc2:=lc;
emit(10); code[lc1].y:= lc;
statement(fsys); code[lc2].y:= lc
end
else code[lc1].y:= lc
end;{ifstatement}
procedure casestatement;
var x: item;
i,j,k,lc1: integer;
casetab: array [1..csmax] of
packed record
val,lc:index
end;
exittab: array [1..csmax] of integer;
procedure caselabel;
var lab: conrec;
K: integer;
begin
constant(fsys+[comma,colon],lab);
if lab.tp <> x.typ then
CCLex.error(47)
else if i=csmax
then CCLex.fatal(6)
else begin
i:= i+1; k:= 0;
casetab[i].val := lab.i;
casetab[i].lc := lc;
repeat
k:= k+1;
until casetab[k].val = lab.i;
if k<i then
CCLex.error(1); {mutiple definition}
end
end; {caselabel}
procedure onecase;
begin
if sy in constbegsys
then begin
caselabel;
while sy= comma do
begin
CCLex.Insymbol; caselabel
end;
if sy = colon
then CCLex.Insymbol else CCLex.error(5);
statement([semicolon,endsy]+fsys);
j := j+1;
exittab[j]:= lc; emit(10)
end
end ;//onecase
begin {casestatement}
CCLex.Insymbol;
i:= 0; j:= 0;
expression(fsys+[ofsy,comma,colon],x);
if not (x.typ in [ints,bools,chars,notyp])
then CCLex.error(23);
lc1:= lc; emit(12); {jmpx}
if sy = ofsy then CCLex.Insymbol else CCLex.error(8);
onecase;
while sy= semicolon do
begin
CCLex.Insymbol;
onecase
end;
code[lc1].y:= lc;
for k:=1 to i do
begin
emit1(13,casetab[k].val);
emit1(13,casetab[k].lc)
end;
emit1(10,0);
for k:= 1 to j do code [exittab[k]].y:= lc;
if sy= endsy then CCLex.Insymbol else CCLex.error(57)
end;//casestatement
procedure repeatstatement;
var x: item;
lc1: integer;
begin
lc1:= lc;
CCLex.Insymbol;
statement([semicolon,untilsy]+fsys);
while sy in [semicolon]+statbegsys do
begin
if sy = semicolon then CCLex.Insymbol else CCLex.error(14);
statement([semicolon,untilsy]+fsys)
end;
if sy = untilsy
then begin
CCLex.Insymbol;
expression(fsys,x);
if not (x.typ in [bools,notyp]) then CCLex.error(17);//??
emit1(11,lc1)
end else CCLex.error(53)
end ; //repeatstatement
procedure whilestatement;
var x: item;
lc1,lc2: integer;
begin
CCLex.Insymbol;
lc1:= lc;
expression(fsys+[dosy],x);
if not (x.typ in [bools,notyp]) then CCLex.error(17);
lc2:= lc; emit(11);
if sy= dosy then CCLex.Insymbol else CCLex.error(54);
statement(fsys);
emit1(10,lc1);
code[lc2].y := lc
end;//whilestatement
procedure forstatement;
var cvt: types;
x: item;
i,f,lc1,lc2: integer;
begin
CCLex.Insymbol;
if sy = ident
then begin
i:= loc(id);
CCLex.Insymbol;
if i=0
then cvt:=ints
else if tab[i].obj =vvariable
then begin
cvt:= tab[i].typ;
if no⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -