ucscompiler.pas
来自「本Delphi项目文件为本人在一个Pascal-s（子集）源代码基础上完成的。本」· PAS 代码 · 共 1,455 行 · 第 1/5 页
PAS
1,455 行
end else begin //array selector
if sy<>lbrack then CCLex.error(11);
repeat
CCLex.Insymbol;
expression(fsys+[comma,rbrack],x);
if v.typ<>arrays
then CCLex.error(28)
else begin
a:= v.ref;
if atab[a].inxtyp<>x.typ
then CCLex.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 CCLex.Insymbol
else begin
CCLex.error(12);
if sy=rparent then CCLex.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
CCLex.Insymbol;
if cp>= lastp
then CCLex.error(39)
else begin
cp:= cp+1;
if tab[cp].normal
then begin
expression(fsys+[comma,colon,rparent],x);
if x.typ=tab[cp].typ
then begin
if x.ref< tab[cp].ref
then CCLex.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 CCLex.error(36);
end else begin //variable parameter
if sy<>ident
then CCLex.error(2)
else begin k:= loc(id);
CCLex.Insymbol;
if k<>0
then begin
if tab[k].obj<>vvariable then CCLex.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 CCLex.error(36)
end
end
end;//variable parameter
end;
test([comma,rparent],fsys,6);
until sy<>comma;
if sy= rparent then CCLex.Insymbol else CCLex.error(4)
end;
if cp< lastp then CCLex.error(39);//too few 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
CCLex.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(fsys:symset; var X:item);
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
if sy=lparent
then CCLex.Insymbol
else CCLex.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;
4,5://odd ,chr
ts:= [ints];
6://odr
ts:= [ints,bools,chars];
7,8: //succ,pred
begin
ts:= [ints,bools,chars];
tab[i].typ:= x.typ
end;
9..16://round,trunc,...,sin,cos
begin
ts:= [ints,reals];
if x.typ=ints then emit1(26,0)
end;
end;//case
if x.typ in ts
then emit1(8,n)
else if x.typ<>notyp
then CCLex.error(48);
end else begin {n in [17,18]}
if sy<>ident
then CCLex.error(2)
else if id<>'input'
then CCLex.error(0)
else CCLex.Insymbol;
emit1(8,n);
end;
x.typ:= tab[i].typ;
if sy=rparent then CCLex.Insymbol else CCLex.error(4)
end;{standfct}
begin {factor}
x.typ:= notyp;
x.ref:= 0;
test(facbegsys,fsys,58);
while sy in facbegsys do
begin
if sy=ident
then begin
i := loc(id);
CCLex.Insymbol;
with tab[i] do
case obj of
konstant: begin
x.typ:= typ;
x.ref:= 0;
if x.typ=reals
then emit1(25,adr)
else emit1(24,adr)
end;
vvariable: begin
x.typ:= typ;
x.ref:= ref;
if sy in [lbrack,lparent,period]
then begin
if normal then f:=0 else f:=1;
emit2(f,lev,adr);
selector(fsys,x);
if x.typ in stantyps then emit(34)
end else begin
if x.typ in stantyps
then if normal
then f:=1
else f:=2
else if normal then f:=0 else f:=1;
emit2(f,lev,adr)
end
end;
typel,prozedure:CCLex.error(44);
funktion:begin
x.typ:=typ;
if lev<>0
then call(fsys,i)
else standfct(adr)
end
end {case ,with}
end else if sy in [charcon,intcon,realcon]
then begin
if sy=realcon
then begin
x.typ:= reals;
enterreal(CCLex.rnum);
emit1(25,c1)
end else begin
if sy= charcon
then x.typ:= chars
else x.typ:= ints;
emit1(24,inum)
end;
x.ref:= 0;
CCLex.Insymbol
end else if sy=lparent
then begin
CCLex.Insymbol;
expression(fsys+[rparent],x);
if sy= rparent
then CCLex.Insymbol
else CCLex.error(4)
end else if sy=notsy
then begin
CCLex.Insymbol;
factor(fsys,x);
if x.typ=bools
then emit(35)
else if x.typ<>notyp
then CCLex.error(32)
end;
test(fsys,facbegsys,6)
end //while
end;//factor
begin //term
factor(fsys+[times,rdiv,idiv,imod,andsy],x);
while sy in[times,rdiv,idiv,imod,andsy] do
begin
op:= sy;
CCLex.Insymbol;
factor(fsys+[times,rdiv,idiv,imod,andsy],y);
if op=times
then begin
x.typ:= resulttype(x.typ,y.typ);
case x.typ of
notyp:;
ints: emit(57);
reals: emit(60);
end
end else if op=rdiv
then begin
if x.typ = ints
then begin
emit1(26,1);
X.TYP:=reals;
end;
if y.typ=ints
then begin
emit1(26,0);
y.typ:= reals;
end;
if (x.typ=reals) and (y.typ=reals)
then emit(61)
else begin
if(x.typ<>notyp) and(y.typ<>notyp)
then CCLex.error(33);
x.typ:=notyp;
end
end else if op=andsy
then begin
if (x.typ=bools)and(y.typ=bools)
then emit(56)
else begin
if(x.typ<>notyp) and(y.typ<>notyp)
then CCLex.error(32);
x.typ:= notyp
end
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?