(* Copyright (C) 1989, Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* File: LoopStmt.m3 *) (* Last modified on Sat Feb 10 20:39:29 1990 by kalsow *) (* modified on Mon Oct 16 14:12:01 1989 by muller *) MODULE LoopStmt; IMPORT Error, Emit, Scanner, Stmt, StmtRep, Marker, String, Token; TYPE P = Stmt.T OBJECT 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; VAR p: P; BEGIN p := NEW (P); StmtRep.Init (p); Scanner.Match (TK.tLOOP, fail, Token.Set {TK.tEND}); p.body := Stmt.Parse (fail + Token.Set {TK.tEND}); Scanner.Match (TK.tEND, fail, Token.Set {}); RETURN p; END Parse; PROCEDURE Bind (p: P) = BEGIN Stmt.Bind (p.body); END Bind; PROCEDURE Check (p: P) = BEGIN Marker.PushExit (NIL, 0); Stmt.TypeCheck (p.body); Marker.Pop (); END Check; PROCEDURE Precompile (p: P) = BEGIN Marker.PushExit (NIL, 0); Stmt.Precompile (p.body); Marker.Pop (); END Precompile; PROCEDURE Compile (p: P): Stmt.Outcomes = VAR label: INTEGER; oc: Stmt.Outcomes; BEGIN label := nextID; INC (nextID); IF (labelPrefix = NIL) THEN labelPrefix := String.Add ("loop_exit_") END; Marker.PushExit (labelPrefix, label); Emit.OpI ("loop_@:;\n\001", label); oc := Stmt.Compile (p.body); Marker.Pop (); IF (Stmt.Outcome.FallThrough IN oc) THEN Emit.OpI ("goto loop_@;\n", label); oc := oc - Stmt.Outcomes {Stmt.Outcome.FallThrough}; END; Emit.Op ("\002"); IF (Stmt.Outcome.Exits IN oc) THEN Emit.OpSI ("@@: /**/;\n", labelPrefix, label); oc := oc + Stmt.Outcomes {Stmt.Outcome.FallThrough} - Stmt.Outcomes {Stmt.Outcome.Exits}; END; RETURN oc; END Compile; BEGIN END LoopStmt.