ELSIF sym = for THEN (* построение синтаксического дерева для FOR *)
OPS.Get(sym); (* взять символ после FOR *)
IF sym = ident THEN qualident(id); (* если это идентификатор, уточнить его *)
IF ~(id^.typ^.form IN intSet) THEN err(68) END ;(* он должен быть целого типа*)
CheckSym(becomes); Expression(y); pos := OPM.errpos; (* потом д б «:= выражение (А)» *)
x := OPB.NewLeaf(id); OPB.Assign(x, y); SetPos(x);(* вставим в дерево «id := А» *)
OPB.Link(stat, last, x); (* не очень понятно, похоже как-то связано с присваиванием*)
CheckSym(to); Expression(y); pos := OPM.errpos; (* далее д б ТО выражение (В) *)
IF sym = by THEN (* если далее задан шаг BY Step,*)
OPS.Get(sym); ConstExpression(z) (* то читаем его как константное выражение*)
ELSE
z := OPB.NewIntConst(1) (*иначе берем константу 1*)
END ;
IF (y^.class = Nconst) THEN
IF (y^.typ^.form < SInt) OR (y^.typ^.form > x^.left^.typ^.form) THEN
err(113); t := id; obj := NIL; (* то это д б константа совместимого типа *)
ELSIF (ABS(z^.conval^.intval)=1)& (ABS(y^.conval^.intval) <= 1) THEN
(* частные случаи, когда переменная t не нужна*)
t := id; (* вместо t используем id *)
IF y^.conval^.intval = 0 THEN obj := NIL
ELSIF y^.conval^.intval = z^.conval^.intval THEN obj := id
ELSE obj := z.typ.strobj; ASSERT( obj # id);
END
ELSE
name := "@@"; OPT.Insert(name, t); (* нужна переменная t*)
END
ELSE (* B - не константа *)
name := "@@"; OPT.Insert(name, t); (* нужна переменная t*)
END;
IF t # id THEN
t^.name := "@for" ; t^.mode := Var; t^.typ := x^.left^.typ; (* в таблице имен создаем*)
obj := OPT.topScope^.scope; (*вспомогательную *)
IF obj = NIL THEN OPT.topScope^.scope := t (* переменную t для счетчика повторений*)
ELSE
WHILE obj^.link # NIL DO obj := obj^.link END ;
obj^.link := t
END ;
obj:= t; ASSERT( obj # id);
END;
(* Переменные t и obj задают 4 случая цикла *)
IF t # id THEN
x:= OPB.NewLeaf(t); OPB.Assign(x, y); SetPos(x); (* t := B*)
OPB.Link(stat, last, x);
pos := OPM.errpos; (* теперь ошибка будет указывать на шаг*)
x := OPB.NewLeaf(id);y:=OPB.NewLeaf(t);
(* z = "Step", x = "id", y = "t" *)
IF z^.conval^.intval > 0 THEN (* подготовим выражение "кол-во повторений" *)
OPB.Op(minus, y,x); (* B-x *)
OPB.Op(div, y, OPB.NewIntConst( z^.conval^.intval)); (* (B-x) div Step *)
OPB.Op(plus, y, OPB.NewIntConst(1)); (* (B-x) div Step +1 *)
x := y;
ELSIF z^.conval^.intval < 0 THEN (* в зависимости от знака Step*)
OPB.Op(minus, x, y); (* x-B *)
OPB.Op(div, x, OPB.NewIntConst( -z^.conval^.intval)); (* (x-B) div Step *)
OPB.Op(plus, x, OPB.NewIntConst(1)); (* (x-B) div Step +1 *)
ELSE err(63); OPB.Op(minus, x, y)
END ;
(* x = " (B-x) div Step +1" или "(x-В) div Step +1 " *)
y := OPB.NewLeaf(t);OPB.Assign(y, x); SetPos(y); (* y = "t := (B-x) div Step +1 " *)
ELSE (* без переменной t *)
IF (obj = NIL) OR (obj = id) THEN (* нужно нейтрализовать первый инкремент*)
y := OPB.NewLeaf(id); OPB.StPar1(y, z, decfn); SetPos(y); (* x= "DEC(id,Step)"*)
ELSE
y := OPB.NewLeaf(id); (* y = "id" - фиктивный оператор, т.к. нейтрализация не нужна *)
END
END;
pos := OPM.errpos;
IF z^.conval^.intval=0 THEN err(63) END; (* нулевой шаг недопустим*)
x := OPB.NewLeaf(id); OPB.StPar1(x, z, incfn); SetPos(x); (* x= "INC(id,Step)"*)
y^.link := x; (* t := (B-x) div Step +1; INC(id,Step) *)
IF t # id THEN (* добавить DEC(t) *)
x := OPB.NewLeaf(t); OPB.StPar1(x, OPB.NewIntConst(1), decfn); SetPos(x);
y^.link^.link := x; (* t := (B-x) div Step +1; INC(id,Step); DEC(t) *)
END;
CheckSym(do); StatSeq(s); (* дальше д б DO и тело цикла s *)
IF s = NIL THEN
s := y^.link; (* если тело цикла — пусто, то там д б только INC(id,Step); [ DEC(t) ] *)
ELSIF (obj=NIL) OR (obj = id) THEN
y^.link^.link := s; s:=y^.link; (* добавляем в начало тела цикла INC(n,Step); *)
ELSE (* ищем конец тела цикла *)
x := s;
WHILE x^.link # NIL DO x := x^.link END ;
x^.link := y^.link; (* добавляем в конец тела цикла INC(n,Step); [ DEC(t) ]*)
END;
CheckSym(end); (* в конце д б END *)
IF obj # id THEN
x := OPB.NewLeaf(t); OPB.Op(eql, x, OPB.NewIntConst(0)); (* условие "t = 0" "(id = 0)" *)
ELSE
x := OPB.NewLeaf(id);
IF z^.conval^.intval > 0 THEN OPB.Op(gtr, x, OPB.NewIntConst(0)) (* условие id > 0 *)
ELSIF z^.conval^.intval < 0 THEN OPB.Op(lss, x, OPB.NewIntConst(0)) (* или id < 0 *)
END
END;
OPB.Construct(Nrepeat, s,x);SetPos(s); (* REPEAT ...UNTIL t=0; (id >0, id <0)*)
y^.link := s; (* t := (B-x) div Step +1; REPEAT ... UNTIL t=0; *)
IF y^.class = Nvar THEN (* фиктивный оператор *)
s:=y^.link ; (* отбросим фиктивный оператор*)
ELSE
s:=y
END;
x := OPB.NewLeaf(id); (*начинаем строить условие IF*)
IF t # id THEN y := OPB.NewLeaf(t)
ELSIF obj = NIL THEN y := OPB.NewIntConst(0)
ELSIF obj = id THEN y := z
ELSE y:= OPB.NewIntConst( -z^.conval^.intval )
END;
(* y = <B> = "t" или "+-Step" (для условия IF) *)
IF z^.conval^.intval > 0 THEN OPB.Op(leq, x, y) (* условие id <= B *)
ELSE OPB.Op(geq, x, y); (* или id >= B*)
END ;
OPB.Construct(Nif, x, s); SetPos(x); lastif := x; (* строим IF id<=B THEN ...*)
OPB.Construct(Nifelse, x, NIL); (* ветви ELSE нет*)
OPB.OptIf(x); pos := OPM.errpos
ELSE err(ident)
END