📄 source.htm
字号:
'[',']',',' :begin
concatenation;
wtype:=other;
wval:=token;
end;
':' :begin
concatenation;
getchar;
if character<>'=' then retract
else concatenation;
wtype:=other;
wval:=token;
end;
'<' :begin
concatenation;
getchar;
if (character<>'>') and (character<>'=') then
retract
else concatenation;
wtype:=relop;
wval:=token;
end;
'>' :begin
concatenation;
getchar;
if character<>'=' then retract
else concatenation;
wtype:=relop;
wval:=token;
end;
'=' :begin
concatenation;
wtype:=relop;
wval:=token;
end;
'+','-' :begin
concatenation;
wtype:=addop;
wval:=token;
end;
'*' :begin
concatenation;
wtype:=multiop;
wval:=token;
end;
'{' :begin
while character<>'}' do
getchar;
lexicure;
end;
'.' :begin
concatenation;
getchar;
if character<>'.' then retract
else concatenation;
wtype:=other;
wval:=token;
end;
#26 :begin
wtype:=endfile;
end;
else begin
error(20);
lexicure
end
end;
end
else retract_w:=false;
END;
{-------<a
name="yufa analysis">yufa analysis</a>-----------------------------------------------}
FUNCTION writefile(int:integer):integer;
BEGIN
if not errorhappen then
begin
write(fdestinate,int);
writefile:=filepointer;
filepointer:=filepointer+1;
end;
END;
PROCEDURE backpatch(index,int:integer);
BEGIN
if not errorhappen then
begin
seek(fdestinate,index);
write(fdestinate,int);
seek(fdestinate,filepointer);
end;
END;
FUNCTION <a
name="_const">_const</a>(var convalue:integer;var contype:idtype):boolean;
VAR
errorcode:integer;
point:idpointer;
factor:integer;
BEGIN
factor:=1;
lexicure;
if (wval='-') or (wval='+') then
begin
if wval='-' then factor:=-1;
lexicure;
end;
if wtype=id then
begin
point:=lookup(wval);
if point=nil then
begin
error(23);
_const:=false;
end
else
begin
if point^.idclass<>1 then
begin
error(15);
_const:=false;
end
else
begin
with point^ do
begin
convalue:=factor*value;
contype:=consttype;
end;
_const:=true;
end
end
end
else if wtype=num then
begin
val(wval,convalue,errorcode);
if convalue<0 then error(21);
convalue:=factor*convalue;
contype:=int;
_const:=true;
end
else
begin
error(15);
_const:=false;
end;
END;
PROCEDURE <a
name="_const_session">_const_session</a>;
VAR
point:idpointer;
convalue:integer;
contype:idtype;
BEGIN
lexicure;
if wval<>'CONST' then retract_w:=true
else
begin
lexicure;
repeat
if wtype<>id then
begin
error(16);
skip_in_const;
end
else
begin
point:=insert(wval);
if point<>nil then
begin
with point^ do
begin
size:=1;
idclass:=1;
end;
lexicure;
if wval<>'=' then
begin
error(6);
deleteCurent;
skip_in_const;
end
else
begin
if _const(convalue,contype)=false then
begin
deleteCurent;
skip_in_const
end
else
begin
with point^ do
begin
value:=convalue;
consttype:=contype;
end;
lexicure;
if wval<>';' then
begin
error(5);
skip_in_const;
end;
end;
end;
end
else
begin
error(2);
deleteCurent;
skip_in_const;
end;
end;
lexicure;
until (wval='TYPE') or (wval='VAR') or (wval='PROCEDURE')
or (wval='BEGIN');
retract_w:=true
end
END;
PROCEDURE <a
name="_recordlist">_recordlist</a>(point:idpointer);
VAR
continue,first:boolean;
oldcount,count,displ,i:integer;
typepoint:idpointer;
interrupt:boolean;
PROCEDURE insertfield;
BEGIN
if count>MAXfield then
error(37)
else
begin
i:=1;
interrupt:=false;
while (i<count) and (not interrupt) do
begin
if point^.items[count].name=copy(wval,1,12) then
begin
error(2);
interrupt:=true;
end;
count:=count+1;
end;
if (not interrupt) then
begin
point^.items[count].name:=copy(wval,1,12);
count:=count+1;
end;
end;
END;
BEGIN
oldcount:=1;
count:=1;
displ:=0;
continue:=true;
first:=true;
lexicure;
repeat
if not first then
begin
if wval<>';' then
begin
error(5);
retract_w:=true;
end;
lexicure;
end
else first:=false;
if wtype<>id then
begin
error(16);
skip_in_record;
continue:=false;
end;
if continue then
begin
insertfield;
lexicure;
while (wval=',') and continue do
begin
lexicure;
if wtype<>id then
begin
error(16);
skip_in_record;
continue:=false;
end;
if continue then
begin
insertfield;
lexicure;
end;
end;
if wval<>':' then
begin
error(7);
continue:=false;
count:=oldcount;
skip_in_record;
end
end;
if continue then
begin
lexicure;
if wtype<>id then
begin
error(16);
continue:=false;
count:=oldcount;
skip_in_record;
end
else
begin
typepoint:=lookup(wval);
if typepoint=nil then
begin
error(23);
continue:=false;
count:=oldcount;
skip_in_record;
end
else if not (typepoint^.idclass in [2,3,4]) then
begin
error(24);
continue:=false;
count:=oldcount;
skip_in_record;
end;
end;
end;
if continue then
begin
for i:=oldcount to count-1 do
begin
with point^.items[i] do
begin
fieldtype:=typepoint;
offset:=displ;
end;
displ:=displ+typepoint^.size;
end;
oldcount:=count;
end;
lexicure;
continue:=true;
until (wval='END') or (wval='VAR') or (wval='PROCEDURE')
or (wval='BEGIN');
point^.size:=displ;
point^.itemnum:=count-1;
if wval<>'END' then
begin
error(38);
retract_w:=true;
end;
END;
FUNCTION <a
name="_type_df"><aname="_type_df">_type_df</a>(point:idpointer):boolean;
VAR
typepoint:idpointer;
continue:boolean;
minval,maxval:integer;
mintype,maxtype:idtype;
BEGIN
continue:=true;
lexicure;
if (wval<>'ARRAY') and (wval<>'RECORD') then
begin
error(14);
_type_df:=false;
continue:=false;
end;
if continue and (wval='ARRAY') then
begin
lexicure;
if wval<>'[' then
begin
error(8);
_type_df:=false;
continue:=false;
end;
if continue then
if _const(minval,mintype)=false then
begin
_type_df:=false;
continue:=false;
end;
if continue then
begin
lexicure;
if wval<>'..' then
begin
error(9);
_type_df:=false;
continue:=false;
end;
end;
if continue then
if _const(maxval,maxtype)=false then
begin
_type_df:=false;
continue:=false;
end;
if continue then
if mintype<>maxtype then
begin
error(11);
_type_df:=false;
continue:=false;
end;
if continue then
if minval>maxval then
begin
error(36);
_type_df:=false;
continue:=false;
end;
if continue then
begin
lexicure;
if wval<>']' then
begin
error(12);
_type_df:=false;
continue:=false;
end
end;
if continue then
begin
lexicure;
if wval<>'OF' then
begin
error(13);
_type_df:=false;
continue:=false;
end;
end;
if continue then
begin
lexicure;
if wtype<>id then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -