📄 source.htm
字号:
begin
error(16);
_type_df:=false;
continue:=false;
end;
end;
if continue then
begin
typepoint:=lookup(wval);
if typepoint=nil then
begin
error(23);
_type_df:=false;
continue:=false;
end;
end;
if continue then
if not typepoint^.idclass in [2,3,4] then
begin
error(24);
_type_df:=false;
continue:=false;
end;
if continue then
begin
with point^ do
begin
size:=typepoint^.size*(maxval-minval+1);
idclass:=2;
minindex:=minval;
maxindex:=maxval;
indextype:=mintype;
elementtype:=typepoint;
end;
_type_df:=true;
end;
if continue then
begin
lexicure;
if wval<>';' then
begin
error(5);
_type_df:=true;
end;
continue:=false;
end;
end;
if continue and (wval='RECORD') then
begin
point^.idclass:=3;
_recordlist(point);
lexicure;
if wval<>';' then
begin
error(5);
_type_df:=false;
end
else _type_df:=true;
end;
END;
PROCEDURE <a
name="_type_session">_type_session</a>;
VAR
point:idpointer;
BEGIN
lexicure;
if wval<>'TYPE' then retract_w:=true
else
begin
lexicure;
repeat
if wtype<>id then
begin
error(16);
skip_in_type
end
else
begin
point:=insert(wval);
if point<>nil then
begin
lexicure;
if wval<>'=' then
begin
error(6);
deleteCurent;
skip_in_type;
end
else if _type_df(point)=false then
begin
deleteCurent;
skip_in_type
end;
end;
end;
lexicure;
until (wval='VAR') or (wval='PROCEDURE') or (wval='BEGIN');
retract_w:=true
end
END;
PROCEDURE <a
name="_var_list">_var_list</a>;
BEGIN
insertname(wval);
lexicure;
while wval=',' do
begin
lexicure;
insertname(wval);
lexicure;
end;
retract_w:=true;
END;
PROCEDURE <a
name="_var_session">_var_session</a>(var varlength:integer);
VAR
continue:boolean;
point,typepoint:idpointer;
nameitem:namelinkp;
displ:integer;
BEGIN
lexicure;
if wval<>'VAR' then
begin
retract_w:=true;
varlength:=0
end
else
begin
continue:=true;
displ:=3;
lexicure;
repeat
if wtype<>id then
begin
error(16);
continue:=false;
skip_in_var;
end;
if continue then
begin
_var_list;
lexicure;
if wval<>':' then
begin
error(7);
continue:=false;
deletelist;
skip_in_var;
end;
end;
if continue then
begin
lexicure;
if wtype<>id then
begin
error(16);
continue:=false;
deletelist;
skip_in_var;
end
else
begin
typepoint:=lookup(wval);
if typepoint=nil then
begin
error(23);
continue:=false;
deletelist;
skip_in_var;
end
else if not (typepoint^.idclass in [2,3,4]) then
begin
error(24);
continue:=false;
deletelist;
skip_in_var;
end;
end;
end;
if continue then
begin
nameitem:=namelist;
while nameitem<>nil do
begin
point:=insert(nameitem^.name);
if point<>nil then
with point^ do
begin
size:=typepoint^.size;
idclass:=5;
vartype:=typepoint;
isvarparam:=false;
offset:=displ;
end;
displ:=displ+typepoint^.size;
nameitem:=nameitem^.next;
end;
deletelist;
end;
lexicure;
if wval<>';' then
begin
error(5);
retract_w:=true;
end;
lexicure;
continue:=true;
until (wval='PROCEDURE') or (wval='BEGIN');
retract_w:=true;
varlength:=displ;
end;
END;
FUNCTION <a
name="_param">_param</a>(point:idpointer):boolean;
VAR
continue,varparam,first:boolean;
count,displ:integer;
typepoint,temppoint:idpointer;
nameitem:namelinkp;
thispoint:idpointer;
BEGIN
lexicure;
if wval='(' then
begin
count:=1;
first:=true;
lexicure;
repeat
varparam:=false;
continue:=true;
if not first then
begin
if wval<>';' then error(5)
else lexicure;
end
else first:=false;
if wval='VAR' then
begin
lexicure;
varparam:=true;
end;
if wtype<>id then
begin
error(16);
continue:=false;
skip_in_param;
end;
if continue then
begin
_var_list;
lexicure;
if wval<>':' then
begin
error(7);
continue:=false;
deletelist;
skip_in_param;
end;
end;
if continue then
begin
lexicure;
if wtype<>id then
begin
error(16);
continue:=false;
deletelist;
skip_in_param;
end
else
begin
typepoint:=lookup(wval);
if typepoint=nil then
begin
error(23);
continue:=false;
deletelist;
skip_in_param;
end
else if not (typepoint^.idclass in [2,3,4]) then
begin
error(24);
continue:=false;
deletelist;
skip_in_param;
end;
end;
end;
if continue then
begin
nameitem:=namelist;
while nameitem<>nil do
begin
thispoint:=insert(nameitem^.name);
with thispoint^ do
begin
size:=typepoint^.size;
idclass:=5;
vartype:=typepoint;
isvarparam:=varparam;
end;
if count<=MAXparam then
begin
point^.params[count].paramtype:=typepoint;
point^.params[count].isVar:=varparam;
count:=count+1;
end;
nameitem:=nameitem^.next;
end;
deletelist;
end;
lexicure;
until (wval='PROCEDURE') or (wval='BEGIN') or (wval=')')
or (wval='TYPE') or (wval='CONST') or (wval='VAR');
if count>MAXparam then
error(3);
point^.paramnum:=count-1;
displ:=-1;
temppoint:=curProVarL;
while temppoint<>nil do
begin
with temppoint^ do
begin
offset:=displ;
displ:=displ-size;
end;
temppoint:=temppoint^.next_varList_id;
end;
point^.paramlength:=-displ-1;
if wval<>')' then
begin
error(35);
retract_w:=true;
_param:=false
end
else _param:=true;
end
else
begin
retract_w:=true;
_param:=true;
point^.paramlength:=0;
point^.paramnum:=0;
end;
END;
PROCEDURE <a
name="_proc_df">_proc_df</a>(var displ:integer);
VAR
oldfilepoint:integer;
continue:boolean;
point:idpointer;
index1,index2,index3,temp:integer;
varlength,templength,thisdispl:integer;
BEGIN
lexicure;
oldfilepoint:=filepointer;
while (wval='PROCEDURE') do
begin
lexicure;
if wtype<>id then
begin
error(16);
fatalerror;
end
else
begin
point:=insert(wval);
point^.idclass:=6;
point^.isStandard:=false;
curLevel:=curLevel+1;
push;
temp:=writefile(24);
point^.address:=temp;
index1:=writefile(0);
index2:=writefile(0);
index3:=writefile(0);
temp:=writefile(lineno);
end;
if _param(point)=true then
begin
lexicure;
if wval<>';' then
begin
error(5);
retract_w:=true;
end;
end;
_body(varlength,templength,thisdispl);
backpatch(index1,varlength);
backpatch(index2,templength);
backpatch(index3,thisdispl);
lexicure;
if wval<>';' then
begin
error(5);
retract_w:=true;
end;
temp:=writefile(6);
temp:=writefile(point^.paramlength);
del_curProVarList;
curLevel:=curLevel-1;
pop;
lexicure;
end;
displ:=filepointer-oldfilepoint+5; { contaned 4 integers}
retract_w:=true;
END;
FUNCTION <a
name="_select">_select</a>(var thistype:idpointer;var templength:integer):boolean;
VAR
success:boolean;
intype:idpointer;
temp,i:integer;
BEGIN
lexicure;
if (thistype^.idclass=2) and (wval<>'[') then
begin
error(8);
success:=false;
end
else if (thistype^.idclass=3) and (wval<>'.') then
begin
error(19);
success:=false;
end
else if (thistype^.idclass<>2) and (thistype^.idclass<>3) then
begin
error(28);
success:=false;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -