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

(* File: RaiseStmt.m3                                          *)
(* Last modified on Tue Apr 10 22:55:12 1990 by muller         *)
(*      modified on Sat Feb 10 21:59:30 1990 by kalsow         *)



MODULE RaiseStmt;

IMPORT Expr, Token, Scanner, Stmt, StmtRep, Error, String;
IMPORT Value, Type, Scope, Void, Emit, Temp;
IMPORT Marker, Target, Exceptionz, AssignStmt;

TYPE
  P = Stmt.T OBJECT
        qid        : String.QID;
        except     : Value.T;
        arg        : Expr.T;
      METHODS
	bind       := Bind;
        check      := Check;
	precompile := Precompile;
	compile    := Compile;
      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.tRAISE, fail, Token.ExprStart);
    p.except     := NIL;
    p.arg        := NIL;
    p.qid.module := NIL;
    p.qid.item   := Scanner.MatchID (fail, Token.Set {TK.tLPAREN, TK.tDOT});
    IF (Scanner.cur.token = TK.tDOT) THEN
      Scanner.GetToken (); (* . *)
      p.qid.module := p.qid.item;
      p.qid.item := Scanner.MatchID (fail, Token.Set {TK.tLPAREN});
    END;
    IF (Scanner.cur.token = TK.tLPAREN) THEN
      Scanner.GetToken ();
      p.arg := Expr.Parse (fail);
      Scanner.Match (TK.tRPAREN, fail, Token.Set {});
    END;
    RETURN p;
  END Parse;

PROCEDURE Bind (p: P) =
  VAR v: Value.T;
  BEGIN
    Expr.Bind (p.arg);
    v := Scope.LookUpQID (p.qid);
    IF (v = NIL) THEN
      Error.QID (p.qid, "undefined");
    ELSIF (Value.ClassOf (v) # Value.Class.Exception) THEN
      Error.QID (p.qid, "not an exception");
    ELSE
      p.except := v;
    END;
  END Bind;

PROCEDURE Check (p: P) =
  VAR t, u: Type.T;
  BEGIN
    Expr.TypeCheck (p.arg);
    t := Expr.TypeOf (p.arg);
    u := Exceptionz.ArgType (p.except);
    IF (u = NIL) OR (u = Void.T) THEN
      (* takes no argument *)
      IF (p.arg # NIL) THEN
        Error.QID (p.qid, "exception takes no argument");
      END;
    ELSIF (p.arg = NIL) THEN
      Error.QID (p.qid, "exception requires an argument");
    ELSIF  NOT Type.IsAssignable (u, t) THEN
      Error.QID (p.qid, "argument has wrong type");
    ELSE
      (* argument is passed by reference *)
      p.arg := AssignStmt.CheckRHS (t, p.arg);
      Expr.Bind (p.arg);
      Expr.TypeCheck (p.arg);
    END;
  END Check;

PROCEDURE Precompile (<*UNUSED*> p: P) =
  BEGIN
  END Precompile;

PROCEDURE Compile (p: P): Stmt.Outcomes =
  VAR t1, t2 : Temp.T;  sz : INTEGER;
  BEGIN
    t1 := Value.Load (p.except);
    IF (p.arg = NIL) THEN
      Emit.OpT ("RAISE (& @, 0, 0);\n", t1);
    ELSE
      t2 := Expr.Compile (p.arg);
      IF  NOT Expr.IsDesignator (p.arg) THEN
        VAR t3 := Temp.Alloc (p.arg);
        BEGIN
          Emit.OpTT ("@ = @;\n", t3, t2);
          Temp.Free (t2);
          t2 := t3;
        END;
      END;
      sz := Type.Size (Exceptionz.ArgType (p.except));
      Emit.OpTT ("RAISE (& @, & @, ", t1, t2);
      Emit.OpI ("@);\n", (sz + Target.CHARSIZE - 1) DIV Target.CHARSIZE);
      Temp.Free (t2);
    END;
    Temp.Free (t1);
    RETURN Stmt.Outcomes {(* Raises *)};
  END Compile;

BEGIN
END RaiseStmt.