?? pl0-pas.txt.pas
字號(hào):
gen1(addc, ad)
end end;
procedure addressvar(ref: integer);
begin with itab[ref] do
begin address(vlevel, vadr); if refpar then gen0(load) end
end;
procedure mustbe(x, y: integer);
begin if x<>y then
if (ttab[x].kind=arrays) and (ttab[y].kind=arrays) and
(ttab[x].low=ttab[y].low) and (ttab[x].high=ttab[y].high)
then mustbe(ttab[x].elemtip, ttab[y].elemtip)
else error(107)
end;
procedure expression(var x: integer);
forward;
procedure selector(var t: integer; var ref: integer);
var j, x: integer;
begin t:= itab[ref].tip; getsym;
if sym in [period, lbrack] then begin
addressvar(ref); ref:= 0;
while sym in [period, lbrack] do
case sym of
period : begin if ttab[t].kind<>records then error(108);
getsym; check(ident);
j:= ttab[t].fields; itab[0].name:= id;
while itab[j].name<>id do j:= itab[j].link;
if j=0 then error(109);
gen1(addc, itab[j].offset);
t:= itab[j].tip; getsym
end;
lbrack : begin repeat if ttab[t].kind<>arrays then error(110);
getsym; expression(x); mustbe(intip, x);
gen1(addc, -ttab[t].low);
t:= ttab[t].elemtip;
gen1(mulc, ttab[t].size); gen0(add)
until sym<>comma;
skip(rbrack)
end end end end;
procedure varpar(var t: integer);
var j: integer;
begin check(ident); j:= position; selector(t, j);
if j<>0 then addressvar(j)
end;
procedure standfct(n: integer);
var x, l: integer;
begin case n of
fabs: begin skip(lparen); expression(x); mustbe(intip, x);
gen0(dupl); gen1(ldc, 0); gen0(lssi);
l:= codelabel; gen1(jumpz, 0); gen0(neg);
code[l].a:= codelabel;
skip(rparen)
end;
fsqr: begin skip(lparen); expression(x); mustbe(intip, x);
gen0(dupl); gen0(mul); skip(rparen)
end;
fodd: begin skip(lparen); expression(x); mustbe(intip, x);
gen0(rem2); skip(rparen)
end;
fchr: begin skip(lparen); expression(x); mustbe(intip, x);
skip(rparen)
end;
ford: begin skip(lparen); expression(x); mustbe(chartip, x);
skip(rparen)
end;
fwrite, fwriteln:
begin if n=fwrite then check(lparen);
if sym=lparen then begin
repeat getsym;
if sym=sstring then begin
for x:= 1 to slen do begin
gen1(ldc, ord(str[x]));
gen0(wrc)
end;
getsym
end else begin
expression(x);
if sym=colon then begin
mustbe(intip, x); getsym;
expression(x); mustbe(intip,x);
gen0(wri)
end else if x=intip then begin
gen1(ldc, 8); gen0(wri)
end else if x=chartip then
gen0(wrc)
else
error(111)
end
until sym<>comma;
skip(rparen)
end;
if n=fwriteln then gen0(wrl)
end;
fread, freadln:
begin if n=fread then check(lparen);
if sym=lparen then begin
repeat getsym; varpar(x);
if x=intip then gen0(rdi) else
if x=chartip then gen0(rdc)
else error(112)
until sym<>comma;
skip(rparen)
end;
if n=freadln then gen0(rdl)
end;
feoln: gen0(eol)
end end;
procedure funcall(i: integer);
var d, p, x: integer;
begin getsym;
with itab[i] do
if flevel<0 then
standfct(fadr)
else begin
if tip<>0 then gen1(ldc, 0); p:= i; d:= dx;
if sym=lparen then begin
repeat getsym;
if p=lastpar then error(113); p:= p+1;
if itab[p].refpar then
varpar(x)
else begin
expression(x);
if ttab[x].kind<>simple then gen1(copy, ttab[x].size)
end;
mustbe(itab[p].tip, x)
until sym<>comma;
skip(rparen)
end;
if p<>lastpar then error(114);
if flevel<>0 then address(flevel, 0);
gen1(call, fadr); dx:= d
end end;
procedure factor(var t: integer);
var i: integer;
begin if sym=ident then begin
i:= position; t:= itab[i].tip;
case itab[i].kind of
konst: begin getsym; gen1(ldc, itab[i].val) end;
varbl: begin selector(t, i);
if i<>0 then addressvar(i);
if ttab[t].kind=simple then gen0(load)
end;
funkt: if t=0 then error(115) else funcall(i);
tipe : error(116)
end
end else if sym=number then begin
gen1(ldc, num); t:= intip; getsym
end else if (sym=sstring) and (slen=1) then begin
gen1(ldc, ord(str[1])); t:= chartip; getsym
end else if sym=lparen then begin
getsym; expression(t); skip(rparen)
end else if sym=notsym then begin
getsym; factor(t); mustbe(booltip, t); gen0(neg); gen1(addc, 1)
end else
error(117)
end;
procedure term(var x: integer);
var y: integer;
begin factor(x);
while sym in [andsym, star, divsym, modsym] do begin
if sym=andsym then mustbe(booltip, x) else mustbe(intip, x);
case sym of
star : begin getsym; factor(y); gen0(mul) end;
divsym: begin getsym; factor(y); gen0(divd) end;
modsym: begin getsym; factor(y); gen0(remd) end;
andsym: begin getsym; factor(y); gen0(andb) end
end;
mustbe(x, y)
end end;
procedure simplexpression(var x: integer);
var y: integer;
begin if sym=plus then begin
getsym; term(x); mustbe(intip, x)
end else if sym=minus then begin
getsym; term(x); mustbe(intip, x); gen0(neg)
end else
term(x);
while sym in [orsym, plus, minus] do begin
if sym=orsym then mustbe(booltip, x) else mustbe(intip, x);
case sym of
plus : begin getsym; term(y); gen0(add) end;
minus: begin getsym; term(y); gen0(neg); gen0(add) end;
orsym: begin getsym; term(y); gen0(orb) end
end;
mustbe(x, y)
end end;
procedure expression(var x: integer);
var op: symbol; y: integer;
begin simplexpression(x);
if sym in [eql, neq, lss, leq, gtr, geq] then begin
if ttab[x].kind<>simple then error(118);
op:= sym; getsym; simplexpression(y); mustbe(x, y);
case op of
eql: gen0(eqli);
neq: gen0(neqi);
lss: gen0(lssi);
leq: gen0(leqi);
gtr: gen0(gtri);
geq: gen0(geqi)
end;
x:= booltip
end end;
procedure statement;
var i, j, t, x: integer;
begin if sym=ident then begin
i:= position;
with itab[i] do
case kind of
varbl: begin selector(t, i); skip(becomes);
expression(x); mustbe(t, x);
if i=0 then gen0(swap)
else addressvar(i);
if ttab[t].kind=simple
then gen0(stor)
else gen1(move, ttab[t].size)
end;
funkt: if tip=0 then
funcall(i)
else begin
if not inside then error(119);
getsym; skip(becomes);
expression(x); mustbe(tip, x);
address(flevel+1, resultadr);
gen0(stor)
end;
konst, field, tipe: error(120)
end
end else if sym=ifsym then begin
getsym; expression(t); mustbe(booltip, t); skip(thensym);
i:= codelabel; gen1(jumpz, 0); statement;
if sym=elsesym then begin
getsym; j:= codelabel; gen1(jump, 0);
code[i].a:= codelabel; i:= j; statement
end;
code[i].a:= codelabel
end else if sym=whilesym then begin
getsym; i:= codelabel; expression(t); mustbe(booltip, t);
skip(dosym); j:= codelabel; gen1(jumpz, 0);
statement; gen1(jump, i);
code[j].a:= codelabel
end else if sym=repeatsym then begin
i:= codelabel;
repeat getsym; statement until sym<>semicolon;
skip(untilsym); expression(t); mustbe(booltip, t);
gen1(jumpz, i)
end else if sym=beginsym then begin
repeat getsym; statement until sym<>semicolon;
skip(endsym)
end end;
procedure block(l: integer);
forward;
procedure constant(var c, t: integer);
var i, s: integer;
begin if (sym=sstring) and (slen=1) then begin
c:= ord(str[1]); t:= chartip
end else begin
if sym=plus then begin getsym; s:= +1 end else
if sym=minus then begin getsym; s:= -1 end
else s:= 0;
if sym=ident then begin
i:= position;
if itab[i].kind<>konst then error(121);
c:= itab[i].val; t:= itab[i].tip
end else if sym=number then begin
c:= num; t:= intip
end else
error(122);
if s<>0 then begin mustbe(t, intip); c:= c*s end
end;
getsym
end;
procedure constdeclaration;
var a: alfa; t, c: integer;
begin a:= id; getsym; skip(eql); constant(c, t);
skip(semicolon); enter(a, konst, t); itab[ix].val:= c
end;
procedure typ(var t: integer);
var i, j, sz, ft: integer;
procedure arraytyp(var t: integer);
var x: integer;
begin with ttab[t] do begin
kind:= arrays; getsym; constant(low, x); mustbe(intip, x);
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -