(* Copyright (C) 1992, Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* File: ForStmt.m3 *) (* Last modified on Mon Oct 12 14:18:28 PDT 1992 by kalsow *) (* modified on Tue Nov 27 23:52:39 1990 by muller *) MODULE ForStmt; IMPORT M3, Error, Emit, Scope, Expr, Stmt, StmtRep; IMPORT EnumType, Type, Int, Variable, String, Tracer; IMPORT IntegerExpr, EnumExpr, Temp, Token, Marker; FROM Scanner IMPORT Match, Match1, MatchID, GetToken, cur; TYPE P = Stmt.T OBJECT scope : Scope.T; var : Variable.T; from : Expr.T; limit : Expr.T; step : Expr.T; body : Stmt.T; OVERRIDES check := Check; compile := Compile; outcomes := GetOutcome; END; PROCEDURE Parse (READONLY fail: Token.Set): Stmt.T = TYPE TK = Token.T; CONST Markers = Token.Set{TK.tIDENT,TK.tASSIGN,TK.tTO,TK.tBY,TK.tDO,TK.tEND}; VAR id: String.T; p: P; trace: Tracer.T; BEGIN p := NEW (P); StmtRep.Init (p); Match (TK.tFOR, fail, Markers); id := MatchID (fail, Markers); trace := Variable.ParseTrace (fail + Markers); Match (TK.tASSIGN, fail, Markers); p.from := Expr.Parse (fail + Markers); Match (TK.tTO, fail, Markers); p.limit := Expr.Parse (fail + Token.Set {TK.tBY, TK.tDO, TK.tEND}); p.step := NIL; IF (cur.token = TK.tBY) THEN GetToken (); (* BY *) p.step := Expr.Parse (fail + Token.Set{TK.tDO,TK.tEND}+Token.StmtStart); ELSE p.step := IntegerExpr.New (1); END; p.var := Variable.New (id, TRUE); p.scope := Scope.New1 (p.var); Variable.BindTrace (p.var, trace); Match (TK.tDO, fail, Token.Set {TK.tEND} + Token.StmtStart); p.body := Stmt.Parse (fail + Token.Set {TK.tEND}); Match1 (TK.tEND, fail); Scope.PopNew (); RETURN p; END Parse; PROCEDURE Check (p: P; VAR cs: Stmt.CheckState) = VAR tFrom, tTo, tStep: Type.T; iFrom, iLimit, iStep: INTEGER; z: [0..7]; zz: Scope.T; BEGIN Expr.TypeCheck (p.from, cs); Expr.TypeCheck (p.limit, cs); Expr.TypeCheck (p.step, cs); tFrom := Type.Base (Expr.TypeOf (p.from)); tTo := Type.Base (Expr.TypeOf (p.limit)); tStep := Expr.TypeOf (p.step); IF EnumType.Is (tFrom) THEN IF NOT Type.IsEqual (tFrom, tTo, NIL) THEN Error.Msg ("\'from\' and \'to\' expressions are incompatible"); END; ELSIF (tFrom # Int.T) OR (tTo # Int.T) THEN Error.Msg("\'from\' and \'to\' expressions must be compatible ordinals"); END; IF NOT Type.IsSubtype (tStep, Int.T) THEN Error.Msg ("\'by\' expression must be an integer"); END; (* set the type of the control variable *) Variable.BindType (p.var, tFrom, FALSE, TRUE); (* determine which of the control values are constants *) z := 0; IF Reduce (p.step, iStep) THEN z := 1 END; IF Reduce (p.from, iFrom) THEN INC (z, 2) END; IF Reduce (p.limit, iLimit) THEN INC (z, 4) END; (* compute a better estimate of the control variable's range *) (* x! => x is a constant *) CASE z OF | 0, (* limit from step *) 1, (* limit from step! *) 2, (* limit from! step *) 4 => (* limit! from step *) (* can't improve the situation *) | 3 => (* limit from! step! *) IF (iStep >= 0) THEN Variable.SetBounds (p.var, iFrom, LAST (INTEGER)); ELSE Variable.SetBounds (p.var, FIRST (INTEGER), iFrom); END; | 5 => (* limit! from step! *) IF (iStep >= 0) THEN Variable.SetBounds (p.var, FIRST (INTEGER), iLimit); ELSE Variable.SetBounds (p.var, iLimit, LAST (INTEGER)); END; | 6 => (* limit! from! step *) Variable.SetBounds (p.var, MIN (iLimit, iFrom), MAX (iLimit, iFrom)); | 7 => (* limit! from! step! *) IF (iStep >= 0) THEN Variable.SetBounds (p.var, iFrom, iLimit); ELSE Variable.SetBounds (p.var, iLimit, iFrom); END; END; zz := Scope.Push (p.scope); Scope.TypeCheck (p.scope, cs); Marker.PushExit (0); Stmt.TypeCheck (p.body, cs); Marker.Pop (); Scope.Pop (zz); END Check; PROCEDURE Reduce (VAR expr: Expr.T; VAR i: INTEGER): BOOLEAN = VAR e: Expr.T; t: Type.T; BEGIN e := Expr.ConstValue (expr); IF (e = NIL) THEN RETURN FALSE END; expr := e; RETURN IntegerExpr.Split (e, i) OR EnumExpr.Split (e, i, t); END Reduce; PROCEDURE Compile (p: P): Stmt.Outcomes = VAR step: Expr.T; i, label: INTEGER; t: Type.T; x: Temp.T; oc: Stmt.Outcomes; zz: Scope.T; index: Temp.T; to: Temp.T; by: Temp.T; BEGIN step := Expr.ConstValue (p.step); label := M3.NextLabel; INC (M3.NextLabel); x := Expr.Compile (p.from); index := Temp.AllocEmpty (Int.T); Emit.OpTT ("@ = @;\n", index, x); Temp.Free (x); x := Expr.Compile (p.limit); to := Temp.AllocEmpty (Int.T); Emit.OpTT ("@ = @;\n", to, x); Temp.Free (x); IF (step = NIL) THEN (* non-constant step value *) x := Expr.Compile (p.step); by := Temp.AllocEmpty (Int.T); Emit.OpTT ("@ = @;\n", by, x); Temp.Free (x); END; zz := Scope.Push (p.scope); Emit.Op ("{\001\n"); Scope.Enter (p.scope); Scope.InitValues (p.scope); IF (step # NIL) THEN (* constant step value *) i := 0; IF IntegerExpr.Split (step, i) OR EnumExpr.Split (step, i, t) THEN END; Emit.Op ("for (; "); IF (i > 0) THEN Emit.OpTT ("@ <= @", index, to); ELSE Emit.OpTT ("@ >= @", index, to); END; Emit.OpTI ("; @ += @)", index, i); ELSE Emit.OpT ("for (; (@ < 0)", by); Emit.OpTT ("?(@ >= @):", index, to); Emit.OpTT ("(@ <= @); ", index, to); Emit.OpTT ("@ += @)", index, by); END; Marker.PushExit (label); Emit.Op ("{\001\n"); VAR type: Type.T; indirect, readonly: BOOLEAN; BEGIN Variable.Split (p.var, type, indirect, readonly); Emit.OpV ("@ = ", p.var); Emit.OpF ("(@) ", type); Emit.OpT ("@;\n", index); Variable.ScheduleTrace (p.var); END; oc := Stmt.Compile (p.body); Emit.Op ("\002}\n"); Marker.Pop (); Scope.Exit (p.scope); Emit.Op ("\002}\n"); Scope.Pop (zz); Temp.Free (index); Temp.Free (to); IF (step = NIL) THEN Temp.Free (by) END; IF (Stmt.Outcome.Exits IN oc) THEN Emit.OpL ("@:;\n", label); oc := oc - Stmt.Outcomes {Stmt.Outcome.Exits}; END; (* A FOR statement can always FallThrough; consider the case where the range of the index is empty *) RETURN oc + Stmt.Outcomes {Stmt.Outcome.FallThrough}; END Compile; PROCEDURE GetOutcome (p: P): Stmt.Outcomes = BEGIN RETURN Stmt.GetOutcome (p.body) - Stmt.Outcomes {Stmt.Outcome.Exits} + Stmt.Outcomes {Stmt.Outcome.FallThrough}; END GetOutcome; BEGIN END ForStmt.