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

(* File: LockStmt.m3                                           *)
(* Last modified on Mon Feb 12 09:48:00 1990 by kalsow         *)
(*      modified on Sun Jan 21 07:49:28 1990 by muller         *)



MODULE LockStmt;

IMPORT Expr, Mutex, Error, Type, Stmt, StmtRep, Marker, Temp;
IMPORT Emit, Variable, Token, String, Value, Scope, Procedure;
FROM Scanner IMPORT Match;

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

PROCEDURE Bind (p: P) =
  BEGIN
    Expr.Bind (p.mutex);
    Stmt.Bind (p.body);
  END Bind;

PROCEDURE Check (p: P) =
  VAR t: Type.T;
  BEGIN
    Expr.TypeCheck (p.mutex);
    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.PushFinally (NIL, 0);
    Stmt.TypeCheck (p.body);
    Marker.Pop ();
  END Check;

PROCEDURE Precompile (p: P) =
  BEGIN
    Marker.PushFinally (NIL, 0);
    Stmt.Precompile (p.body);
    Marker.Pop ();
  END Precompile;

PROCEDURE Compile (p: P): Stmt.Outcomes =
  VAR i, label: INTEGER;  x: Temp.T;
    returnSeen, exitSeen: BOOLEAN;  oc: Stmt.Outcomes;
  BEGIN
    i := Type.Name (Mutex.T);
    x := Expr.CompileLValue (p.mutex);
    IF (labelPrefix = NIL) THEN labelPrefix := String.Add ("lock_") END;
    label := nextID;  INC (nextID);
    Emit.OpII ("{\001\nregister t@ mu = (t@)", i, i);
    Emit.OpT ("@;\n", x);
    Temp.Free (x);
    Emit.Op ("_Thread__Acquire (mu);\n");
    Marker.StartOfFinally (labelPrefix, label);
    oc := Stmt.Compile (p.body);
    Marker.MiddleOfFinally (labelPrefix, label, returnSeen, exitSeen);
    Emit.Op ("_Thread__Release (mu);\n");
    Marker.EndOfFinally (labelPrefix, label, returnSeen, exitSeen);
    Emit.Op ("\002};\n");
    RETURN oc;
  END Compile;

BEGIN
END LockStmt.