(* Copyright (C) 1989, Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* File: ForStmt.m3 *) (* Last modified on Wed Mar 21 20:45:34 1990 by muller *) (* modified on Mon Feb 12 10:56:41 1990 by kalsow *) MODULE ForStmt (* EXPORTS ForStmt, M3AST *); IMPORT Error, Emit, Scope, SubrangeType, Expr, Stmt, StmtRep; IMPORT Value, EnumType, Type, Int, Variable, String; IMPORT IntegerExpr, EnumExpr, Temp, Token, Marker; FROM Scanner IMPORT Match, MatchID, GetToken, cur; (* REVEAL M3AST.ForStmt = M3AST.Stmt OBJECT id: M3AST.Id; lo: M3AST.Expr; hi: M3AST.Expr; step: M3AST.Expr; stmts: REF ARRAY OF M3AST.Stmt; END OBJECT scope: Scope.T; var: Variable.T; METHODS bind := Bind; check := Check; precompile := Precompile; compile := Compile; END; TYPE P = M3AST.ForStmt; *) TYPE P = Stmt.T OBJECT scope : Scope.T; var : Variable.T; from : Expr.T; limit : Expr.T; step : Expr.T; body : Stmt.T; METHODS bind := Bind; check := Check; precompile := Precompile; compile := Compile; END; VAR labelPrefix : String.T := NIL; nextID : INTEGER := 0; 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; BEGIN p := NEW (P); StmtRep.Init (p); Match (TK.tFOR, fail, Markers); id := MatchID (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); Match (TK.tDO, fail, Token.Set {TK.tEND} + Token.StmtStart); p.body := Stmt.Parse (fail + Token.Set {TK.tEND}); Match (TK.tEND, fail, Token.Set {}); Scope.PopNew (); RETURN p; END Parse; PROCEDURE Bind (p: P) = VAR iFrom, iLimit, iStep: INTEGER; z: [0..7]; BEGIN Expr.Bind (p.from); Expr.Bind (p.limit); Expr.Bind (p.step); Variable.BindType (p.var, Type.Base (Expr.TypeOf (p.from)), 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; Scope.Push (p.scope); Scope.Bind (p.scope, TRUE); Stmt.Bind (p.body); Scope.Pop (); END Bind; 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 Check (p: P) = VAR tFrom, tTo, tStep: Type.T; BEGIN Expr.TypeCheck (p.from); Expr.TypeCheck (p.limit); Expr.TypeCheck (p.step); 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) 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; Scope.Push (p.scope); Scope.TypeCheck (p.scope, TRUE); Marker.PushExit (NIL, 0); Stmt.TypeCheck (p.body); Marker.Pop (); Scope.Pop (); END Check; PROCEDURE Precompile (p: P) = BEGIN Scope.Push (p.scope); Marker.PushExit (NIL, 0); Stmt.Precompile (p.body); Marker.Pop (); Scope.Pop (); END Precompile; PROCEDURE Compile (p: P): Stmt.Outcomes = VAR step: Expr.T; i, label: INTEGER; t: Type.T; x: Temp.T; oc: Stmt.Outcomes; BEGIN step := Expr.ConstValue (p.step); label := nextID; INC (nextID); IF (labelPrefix = NIL) THEN labelPrefix := String.Add ("for_") END; Emit.Op ("{\001\n"); Emit.Op ("int from, to, index;\n"); IF (step = NIL) THEN Emit.Op ("int by;\n"); END; x := Expr.Compile (p.from); Emit.OpT ("from = @;\n", x); Temp.Free (x); x := Expr.Compile (p.limit); Emit.OpT ("to = @;\n", x); Temp.Free (x); IF (step # NIL) THEN (* constant step value *) Scope.Enter (p.scope); i := 0; IF IntegerExpr.Split (step, i) OR EnumExpr.Split (step, i, t) THEN END; Emit.Op ("for (index = from; "); IF (i < 0) THEN Emit.Op ("index >= to; ") ELSE Emit.Op ("index <= to; ") END; Emit.Op ("index += "); Emit.OpI ("@) {\001\n", i); ELSE (* non-constant step value *) x := Expr.Compile (p.step); Emit.OpT ("by = @;\n", x); Temp.Free (x); Scope.Enter (p.scope); Emit.Op ("for (index = from; "); Emit.Op ("((by<0)?(index>=to):"); Emit.Op ("(index<=to)); "); Emit.Op ("index += by) {\001\n"); END; Scope.Push (p.scope); Marker.PushExit (labelPrefix, label); VAR type: Type.T; indirect, readonly: BOOLEAN; BEGIN Variable.Split (p.var, type, indirect, readonly); Emit.OpV ("@ = ", p.var); Emit.OpI ("(t@) index;\n", Type.Name (type)); END; oc := Stmt.Compile (p.body); Scope.Exit (p.scope); Emit.Op ("\002};\n\002};\n"); IF (Stmt.Outcome.Exits IN oc) THEN Emit.OpSI ("@@: /**/;\n", labelPrefix, label); oc := oc - Stmt.Outcomes {Stmt.Outcome.Exits}; END; Marker.Pop (); Scope.Pop (); (* 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; BEGIN END ForStmt.