📄 source.htm.bak
字号:
success:=_expr(intype,templength);
if success then
if ((thistype^.indextype=bool) and (intype<>boolpoint)) or
((thistype^.indextype=int) and (intype<>intpoint)) then
begin
error(10);
success:=false;
end;
if success then
begin
lexicure;
if wval<>']' then
begin
error(12);
success:=false;
end;
end;
if success then
begin
temp:=writefile(13);
temp:=writefile(thistype^.minindex);
temp:=writefile(thistype^.maxindex);
temp:=writefile(thistype^.elementtype^.size);
temp:=writefile(lineno);
end;
if success then
begin
thistype:=thistype^.elementtype;
if templength<2 then templength:=2;
end;
end;
if success and (wval='.') then
begin
lexicure;
if wtype<>id then
begin
error(16);
success:=false;
end;
if success then
begin
i:=1;
while (i<=thistype^.itemnum) and
(thistype^.items[i].name<>copy(wval,1,12)) do
i:=i+1;
if i>thistype^.itemnum then
begin
error(31);
success:=false;
end;
end;
if success then
begin
temp:=writefile(10);
temp:=writefile(thistype^.items[i].offset);
thistype:=thistype^.items[i].fieldtype;
if templength<2 then templength:=2;
end;
end;
_select:=success;
END;
FUNCTION <a
name="_varvisit">_varvisit</a>(var thistype:idpointer;var templength:integer):boolean;
VAR
success:boolean;
point:idpointer;
temp:integer;
BEGIN
lexicure;
if wtype<>id then
begin
error(16);
success:=false;
end;
if success then
begin
point:=lookup(wval);
if point^.idclass<>5 then
begin
error(16);
success:=false;
end;
end;
if success then
begin
if point^.isvarparam=true then
temp:=writefile(30)
else
temp:=writefile(29);
temp:=writefile(curLevel-point^.level);
temp:=writefile(point^.offset);
end;
thistype:=point^.vartype;
if templength<1 then templength:=1;
if success then
begin
lexicure;
while (wval='.') or (wval='[') and success do
begin
retract_w:=true;
success:=_select(thistype,templength);
lexicure;
end;
retract_w:=true;
end;
_varvisit:=success;
END;
FUNCTION <a
name="_factor">_factor</a>(var thistype:idpointer;var templength:integer):boolean;
VAR
success:boolean;
isConst:boolean;
type1,point:idpointer;
temp:integer;
consttype:idtype;
anum:integer;
BEGIN
lexicure;
if wval='(' then
begin
success:=_expr(thistype,templength);
if success then
begin
lexicure;
if wval<>')' then
begin
error(35);
success:=false
end
end
end
else if wval='NOT' then
begin
thistype:=boolpoint;
success:=_factor(type1,templength);
if success then
if type1<>boolpoint then
begin
error(39);
success:=false;
end;
if success then
temp:=writefile(21)
end
else
begin
if wtype=id then
begin
point:=lookup(wval);
if point=nil then
begin
error(23);
success:=false;
end;
if success then
if point^.idclass=5 then
isConst:=false
else if point^.idclass=1 then
isConst:=true
else begin
error(25);
success:=false;
end;
end;
retract_w:=true;
if success then
begin
if isConst or (wtype=num) then
begin
success:=_const(anum,consttype);
temp:=writefile(3);
temp:=writefile(anum);
if success then
if consttype=int then thistype:=intpoint
else thistype:=boolpoint;
end;
if not isConst then
begin
success:=_varvisit(thistype,templength);
temp:=writefile(28);
temp:=writefile(thistype^.size);
end;
end;
end;
_factor:=success;
if templength<1 then templength:=1;
END;
FUNCTION <a
name="_term">_term</a>(var thistype:idpointer;var templength:integer):boolean;
VAR
success:boolean;
type1:idpointer;
op:string;
opnum:integer;
temp:integer;
BEGIN
success:=_factor(thistype,templength);
if success then
begin
lexicure;
while ((wval='*') or (wval='AND') or (wval='DIV') or
(wval='MOD')) and success do
begin
op:=wval;
success:=_factor(type1,templength);
if success then
if thistype<>type1 then
begin
error(27);
success:=false;
end;
if success then
if ((op<>'AND') and (thistype<>intpoint)) and
((op='AND') and (thistype<>boolpoint)) then
begin
error(39);
success:=false;
end;
if success then
begin
if op='*' then opnum:=17
else if op='AND' then opnum:=1
else if op='DIV' then opnum:=4
else if op='MOD' then opnum:=16;
temp:=writefile(opnum);
end;
lexicure;
if templength<2 then templength:=2;
end;
retract_w:=true;
end;
_term:=success;
END;
FUNCTION <a
name="_simple_expr">_simple_expr</a>(var thistype:idpointer;var templength:integer):boolean;
VAR
factor,temp:integer;
type2:idpointer;
success:boolean;
op:string;
opnum:integer;
BEGIN
lexicure;
factor:=0;
if wtype=addop then
if wval='+' then factor:=1
else factor:=-1
else retract_w:=true;
success:=_term(thistype,templength);
if success then
if factor<>0 then
if thistype<>intpoint then
begin
error(27);
success:=false;
end
else if factor=-1 then temp:=writefile(15);
if success then
begin
lexicure;
while ((wtype=addop) or (wval='OR')) and success do
begin
op:=wval;
success:=_term(type2,templength);
if success then
if thistype<>type2 then
begin
error(27);
success:=false;
end;
if success then
if ((op='OR') and (thistype<>boolpoint)) or
((wtype=addop) and (thistype<>intpoint)) then
begin
error(39);
success:=false;
end;
if success then
begin
if op='+' then opnum:=0
else if op='-' then opnum:=27
else if op='OR' then opnum:=22;
temp:=writefile(opnum);
end;
if templength<2 then templength:=2;
lexicure;
end;
retract_w:=true;
end;
_simple_expr:=success;
END;
FUNCTION <a
name="_expr">_expr</a>(var thistype:idpointer;var templength:integer):boolean;
VAR
success,continue:boolean;
type1,type2:idpointer;
op:string;
opnum:integer;
temp:integer;
BEGIN
success:=_simple_expr(type1,templength);
if success then
begin
lexicure;
if wtype=relop then
begin
continue:=true;
thistype:=boolpoint;
op:=wval
end
else
begin
continue:=false;
thistype:=type1;
retract_w:=true
end;
end;
if success and continue then
success:=_simple_expr(type2,templength);
if success and continue then
if type1<>type2 then
begin
error(27);
success:=false;
end;
if success and continue then
if (type1<>boolpoint) and (type1<>intpoint) then
begin
error(39);
success:=false;
end;
if success and continue then
begin
if op='<' then opnum:=14
else if op='=' then opnum:=9
else if op='>' then opnum:=11
else if op='<=' then opnum:=19
else if op='<>' then opnum:=18
else if op='>=' then opnum:=20;
temp:=writefile(opnum);
if templength<2 then templength:=2;
end;
_expr:=success;
END;
FUNCTION <a
name="_callwrite">_callwrite</a>(var templength:integer):boolean;
VAR
success,first:boolean;
thistype:idpointer;
temp:integer;
BEGIN
first:=true;
success:=true;
lexicure;
if wval<>'(' then
begin
error(34);
success:=false;
end;
repeat
if success then
if not first then
begin
if wval<>',' then
begin
error(18);
success:=false;
end
end
else first:=false;
if success then
success:=_expr(thistype,templength);
if success then
if (thistype^.idclass<>4) then
begin
error(14);
success:=false;
end;
if success then
if thistype^.typename=int then temp:=writefile(31)
else temp:=writefile(32);
lexicure;
until (wval=')') or (not success);
_callwrite:=success;
END;
FUNCTION <a
name="_callread">_callread</a>(var templength:integer):boolean;
VAR
first,success:boolean;
temp:integer;
thistype:idpointer;
BEGIN
first:=true;
success:=true;
lexicure;
if wval<>'(' then
begin
error(34);
success:=false;
end;
repeat
if success then
if not first then
begin
if wval<>',' then
begin
error(18);
success:=false;
end
end
else first:=false;
if success then
success:=_varvisit(thistype,templength);
if su
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -