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

(* File: TryFinStmt.m3                                         *)
(* Last modified on Mon Mar  2 11:12:16 PST 1992 by kalsow     *)
(*      modified on Thu Dec  5 17:19:13 PST 1991 by muller     *)

MODULE TryFinStmt;

IMPORT M3, Scope, Token, Scanner, Stmt, StmtRep, Marker, Emit, Frame, Target;
FROM Stmt IMPORT Outcome;

TYPE
  P = Stmt.T OBJECT
        body    : Stmt.T;
        finally : Stmt.T;
        forigin : INTEGER;
        viaProc : BOOLEAN;
        scope   : Scope.T;
      OVERRIDES
        check    := Check;
	compile  := Compile;
        outcomes := GetOutcome;
      END;

PROCEDURE Parse (body: Stmt.T;  READONLY fail: Token.Set): Stmt.T =
  TYPE TK = Token.T;
  VAR p: P;
  BEGIN
    p := NEW (P);
    StmtRep.Init (p);
    p.body := body;
    Scanner.Match (TK.tFINALLY, fail, Token.Set {TK.tEND} + Token.StmtStart);
    p.forigin := Scanner.offset;
    p.scope := Scope.PushNew (TRUE, NIL);
    p.finally := Stmt.Parse (fail + Token.Set {TK.tEND});
    Scope.PopNew ();
    Scanner.Match1 (TK.tEND, fail);
    RETURN p;
  END Parse;

PROCEDURE Check (p: P;  VAR cs: Stmt.CheckState) =
  VAR oc: Stmt.Outcomes;  zz: Scope.T;
  BEGIN
    Marker.PushFinally (0);
    Stmt.TypeCheck (p.body, cs);
    Marker.Pop ();
    oc := Stmt.GetOutcome (p.finally);
    IF (Stmt.Outcome.Exits IN oc) OR (Stmt.Outcome.Returns IN oc) THEN
      p.viaProc := FALSE;
      Scope.IsLexicallyNested (p.scope, TRUE);
      Stmt.TypeCheck (p.finally, cs);
    ELSE
      p.viaProc := TRUE;
      Scope.IsLexicallyNested (p.scope, FALSE);
      zz := Scope.Push (p.scope);
        Scope.TypeCheck (p.scope, cs);
        Stmt.TypeCheck (p.finally, cs);
      Scope.Pop (zz);
    END;
  END Check;

PROCEDURE Compile (p: P): Stmt.Outcomes =
  VAR
    label: INTEGER;
    returnSeen, exitSeen: BOOLEAN;
    has_frame: BOOLEAN;
    oc, xc, o: Stmt.Outcomes;
    save: Emit.Stream;
    zz: Scope.T;
    frame: Frame.T;
  BEGIN
    label := M3.NextLabel;  INC (M3.NextLabel);

    IF (p.viaProc) THEN
      Marker.PushFinallyProc (label);
      save := Emit.SwitchToDecls ();
      Emit.OpI ("_FINALLY_PROC_HANDLER _h@;\n", label);
      INC (Frame.cur.size, 4);
      EVAL Emit.Switch (save);
      Emit.OpI ("_PUSH_FINALLY_PROC (_h@, ", label);
      Emit.OpI ("_FINALLY_@, ", label);
      has_frame := Scope.EmitLocalFrameName (p.scope);
      IF NOT has_frame THEN Emit.Op ("_NIL") END;
      Emit.Op  (");\001\n");
        oc := Stmt.Compile (p.body);
      Marker.Pop ();
      Emit.Op  ("\002");
      Scanner.offset := p.forigin;
      IF (Outcome.FallThrough IN oc) THEN
        Emit.OpI ("_CUT_TO_NEXT_HANDLER (_h@);\n", label);
        Emit.OpI ("_FINALLY_@ (", label);
        has_frame := Scope.EmitLocalFrameName (p.scope);
        IF NOT has_frame THEN Emit.Op ("_NIL") END;
        Emit.Op  (");\n");
      END;

      save := Emit.Switch (Emit.Stream.Code);
      Frame.Push (frame, 1, TRUE);
      Marker.PushProcedure (NIL, NIL);
      Scanner.offset := p.forigin;
      zz := Scope.Push (p.scope);
        Emit.OpI ("\n_PRIVATE _VOID _FINALLY_@ (_parent)\n", label);
        IF (has_frame)
          THEN Scope.EmitFrameType (p.scope);
          ELSE Emit.Op ("_ADDRESS _parent;\n");
        END;
        Emit.Op ("{\n\001");
        Scope.Enter (p.scope);
          EVAL Emit.SwitchToBody (); Emit.Op ("\001");
          xc := Stmt.Compile (p.finally);
        Scope.Exit (p.scope);
      Scope.Pop (zz);
      Marker.Pop ();
      Frame.Pop (frame);
      EVAL Emit.Switch (save);
    ELSE
      Marker.PushFinally (label);
      save := Emit.SwitchToDecls ();
      Emit.OpI ("_TRY_HANDLER _h@;\n", label);
      INC (Frame.cur.size, 5 + (Target.JumpBufSize DIV Target.ADDRSIZE));
      EVAL Emit.Switch (save);
      Emit.OpI ("_PUSH_FINALLY (_h@, ", label);
      Emit.OpL ("@);\001\n", label);
        oc := Stmt.Compile (p.body);
      Marker.PopFinally (returnSeen, exitSeen);
      Scanner.offset := p.forigin;
      IF (Outcome.FallThrough IN oc) THEN
        Emit.OpI ("_CUT_TO_NEXT_HANDLER (_h@);\n", label);
      END;
      Emit.OpL ("\002@:\n\001", label);
        xc := Stmt.Compile (p.finally);
      Emit.Op ("\002");
      IF (Outcome.FallThrough IN xc) THEN
        Emit.OpI ("if (_h@.exception != _FALL_EXCEPTION) {\001\n", label);
          IF (exitSeen) THEN
            Emit.OpI ("if (_h@.exception == _EXIT_EXCEPTION) {\001\n", label);
            Marker.EmitExit ();
            Emit.Op ("\002}\n");
          END;
          IF (returnSeen) THEN
            Emit.OpI ("if (_h@.exception == _RETURN_EXCEPTION) {\001\n",label);
            Marker.EmitReturn (NIL, NIL);
            Emit.Op ("\002}\n");
          END;
          (* ELSE, a real exception is being raised *)
          Emit.OpII ("_RAISE_FOR_SURE (_h@.exception, _h@.arg);\n",
                         label, label);
        Emit.Op ("\002}\n"); (* if (exception != FALL) ... *)
      END;
    END;


    o := Stmt.Outcomes {};
    IF Outcome.FallThrough IN xc THEN o := oc END;
    IF Outcome.Exits IN xc THEN o := o + Stmt.Outcomes {Outcome.Exits} END;
    IF Outcome.Returns IN xc THEN o := o + Stmt.Outcomes {Outcome.Returns} END;
    RETURN o;
  END Compile;

PROCEDURE GetOutcome (p: P): Stmt.Outcomes =
  VAR oc, xc, o: Stmt.Outcomes;
  BEGIN
    oc := Stmt.GetOutcome (p.body);
    xc := Stmt.GetOutcome (p.finally);
    o := Stmt.Outcomes {};
    IF Outcome.FallThrough IN xc THEN o := oc END;
    IF Outcome.Exits IN xc THEN o := o + Stmt.Outcomes {Outcome.Exits} END;
    IF Outcome.Returns IN xc THEN o := o + Stmt.Outcomes {Outcome.Returns} END;
    RETURN o;
  END GetOutcome;

BEGIN
END TryFinStmt.