(* Copyright (C) 1992, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* File: WhileStmt.m3                                          *)
(* Last modified on Mon Mar  2 11:13:41 PST 1992 by kalsow     *)
(*      modified on Tue Oct 10 18:42:00 1989 by muller         *)

MODULE WhileStmt;

IMPORT M3, Expr, Type, Bool, Error, Emit, Marker;
IMPORT Stmt, StmtRep, Token, Scanner, Temp;

TYPE
  P = Stmt.T OBJECT
        cond    : 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;
  VAR p: P;
  BEGIN
    p := NEW (P);
    StmtRep.Init (p);
    Scanner.Match (TK.tWHILE, fail, Token.Set {TK.tDO, TK.tEND});
    p.cond := Expr.Parse (fail + Token.Set {TK.tDO, TK.tEND});
    Scanner.Match (TK.tDO, fail, Token.Set {TK.tEND});
    p.body := Stmt.Parse (fail + Token.Set {TK.tEND});
    Scanner.Match1 (TK.tEND, fail);
    RETURN p;
  END Parse;

PROCEDURE Check (p: P;  VAR cs: Stmt.CheckState) =
  VAR t: Type.T;
  BEGIN
    Expr.TypeCheck (p.cond, cs);
    t := Expr.TypeOf (p.cond);
    IF (Type.Base (t) # Bool.T) THEN
      Error.Msg ("WHILE condition must be a BOOLEAN");
    END;
    Marker.PushExit (0);
    Stmt.TypeCheck (p.body, cs);
    Marker.Pop ();
  END Check;

PROCEDURE Compile (p: P): Stmt.Outcomes =
  VAR x: Temp.T;  label: INTEGER;  oc: Stmt.Outcomes;
  BEGIN
    label := M3.NextLabel;  INC (M3.NextLabel, 2);

    Emit.OpL ("@:\n\001", label);
    x := Expr.Compile (p.cond);
    Emit.OpT ("if (!(@)) ", x);
    Emit.OpL ("goto @;\n", label+1);
    Temp.Free (x);

    Marker.PushExit (label+1);
    oc := Stmt.Compile (p.body);
    Marker.Pop ();

    IF (Stmt.Outcome.FallThrough IN oc) THEN
      Emit.OpL ("goto @;\n", label);
    END;

    Emit.OpL ("\002@:;\n", label+1);

    (* A WHILE statement can always FallThrough; consider the case where 
       the condition is initially FALSE *)
    RETURN oc + Stmt.Outcomes {Stmt.Outcome.FallThrough}
              - Stmt.Outcomes {Stmt.Outcome.Exits};
  END Compile;

(************************************************************************
PROCEDURE Compile (p: P): Stmt.Outcomes =
  VAR x: Temp.T;  label: INTEGER;  oc: Stmt.Outcomes;
  BEGIN
    label := M3.NextLabel;  INC (M3.NextLabel, 2);

    x := Expr.Compile (p.cond);
    Emit.OpT ("if (@) {\n", x);
    Emit.OpL ("@:;\n\001", label);
    Temp.Free (x);

    Marker.PushExit (label+1);
    oc := Stmt.Compile (p.body);
    Marker.Pop ();

    IF (Stmt.Outcome.FallThrough IN oc) THEN
      x := Expr.Compile (p.cond);
      Emit.OpT ("if (@) ", x);
      Emit.OpL ("goto @;\n", label);
      Temp.Free (x);
    END;
    Emit.Op ("\002}\n");

    IF (Stmt.Outcome.Exits IN oc) THEN
      Emit.OpL ("@:;\n", label+1);
      oc :=  oc - Stmt.Outcomes {Stmt.Outcome.Exits}
    END;

    (* A WHILE statement can always FallThrough; consider the case where 
       the condition is initially FALSE *)
    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.FallThrough}
            - Stmt.Outcomes {Stmt.Outcome.Exits};
  END GetOutcome;

BEGIN
END WhileStmt.