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

(* File: LockStmt.m3                                           *)
(* Last modified on Tue Jun 30 09:20:45 PDT 1992 by kalsow     *)
(*      modified on Sun Jan 21 07:49:28 1990 by muller         *)

MODULE LockStmt;

IMPORT M3, Expr, Mutex, Error, Type, Stmt, StmtRep;
IMPORT Emit, Token, Addr, Marker, Temp, Frame;
FROM Scanner IMPORT Match, Match1;

TYPE
  P = Stmt.T OBJECT
        mutex   : 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);
    Match (TK.tLOCK, fail, Token.Set {TK.tDO, TK.tEND});
    p.mutex := Expr.Parse (fail + Token.Set {TK.tDO, TK.tEND});
    Match (TK.tDO, fail, Token.Set {TK.tEND});
    p.body := Stmt.Parse (fail + Token.Set {TK.tEND});
    Match1 (TK.tEND, fail);
    RETURN p;
  END Parse;

PROCEDURE Check (p: P;  VAR cs: Stmt.CheckState) =
  VAR t: Type.T;
  BEGIN
    Expr.TypeCheck (p.mutex, cs);
    t := Expr.TypeOf (p.mutex);
    IF ( NOT Type.IsSubtype (t, Mutex.T)) THEN
      Error.Msg ("expression must be a mutex");
    ELSIF  NOT Expr.IsDesignator (p.mutex) THEN
      Error.Msg ("mutex must be a designator");
    ELSIF  NOT Expr.IsWritable (p.mutex) THEN
      Error.Msg ("mutex must be writeable");
    END;
    Marker.PushLock (0);
    Stmt.TypeCheck (p.body, cs);
    Marker.Pop ();
  END Check;

PROCEDURE Compile (p: P): Stmt.Outcomes =
  VAR label: INTEGER;  x, mu: Temp.T;  oc: Stmt.Outcomes;  save: Emit.Stream;
  BEGIN
    label := M3.NextLabel;  INC (M3.NextLabel);
    x := Expr.CompileLValue (p.mutex);
    mu := Temp.AllocEmpty (Addr.T);
    Emit.OpTT ("@ = (_ADDRESS) @;\n", mu, x);
    Temp.Free (x);
    Marker.PushLock (label);
      save := Emit.SwitchToDecls ();
      Emit.OpI ("_LOCK_HANDLER _h@;\n", label);
      INC (Frame.cur.size, 3);
      EVAL Emit.Switch (save);
      Emit.OpT ("Thread__Acquire (@);\n", mu);
      Emit.OpI ("_PUSH_LOCK (_h@, ", label);
      Emit.OpT ("@);\001\n", mu);
      Expr.NoteWrite (p.mutex);
      oc := Stmt.Compile (p.body);
      Emit.Op  ("\002");
      IF (Stmt.Outcome.FallThrough IN oc) THEN
        Emit.OpI ("_CUT_TO_NEXT_HANDLER (_h@);\n", label);
        Emit.OpT ("Thread__Release (@);\n", mu);
        Expr.NoteWrite (p.mutex);
      END;
    Marker.Pop ();
    Temp.Free (mu);
    RETURN oc;
  END Compile;

PROCEDURE GetOutcome (p: P): Stmt.Outcomes =
  BEGIN
    RETURN Stmt.GetOutcome (p.body);
  END GetOutcome;

BEGIN
END LockStmt.