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

(* File: Marker.m3                                             *)
(* Last modified on Tue Apr 10 22:51:31 1990 by muller         *)
(*      modified on Sat Feb 10 17:54:33 1990 by kalsow         *)


MODULE Marker;

IMPORT Stmt, Error, Emit, Token, Scanner, String, Type, Variable, ProcType;

TYPE
  Kind = {zFINALLY, zEXIT, zTRY, zTRYELSE, zRAISES, zPROC};

  Marker = RECORD
    kind       : Kind;
    prefix     : Prefix;
    label      : Label;
    returnSeen : BOOLEAN;
    exitSeen   : BOOLEAN;
    type       : Type.T;
    variable   : Variable.T;
    inline     : BOOLEAN;
  END;

CONST
  NoHandler =  -1;

TYPE
  Outcome = RECORD
    exit   : INTEGER;  (* next handler for an EXIT   *)
    eStop  : INTEGER;  (* final handler for an EXIT  *)
    return : INTEGER;  (* next handler for a RETURN  *)
    rStop  : INTEGER;  (* final handler for a RETURN *)
    except : INTEGER;  (* next generic handler       *)
  END;

VAR
  tos   : INTEGER := 0;
  stack : ARRAY [0..50] OF Marker;
  empty : Prefix;

<*INLINE*> PROCEDURE Pop () =
  BEGIN
    DEC (tos);
    WITH z = stack[tos] DO
      IF (z.kind = Kind.zPROC) AND (z.inline) THEN
        Emit.OpI ("return_@:;\n", z.label);
      END;
    END;
  END Pop;

(******************  TRY-FINALLY  *******************************)

PROCEDURE PushFinally (p: Prefix;  x: Label) =
  BEGIN
    Push (Kind.zFINALLY, p, x);
  END PushFinally;

PROCEDURE StartOfFinally (p: Prefix;  x: Label) =
  BEGIN
    PushFinally (p, x);
    Emit.OpSI ("{\001\nHANDLER h@@;\n", p, x);
    Emit.OpSI ("PUSH_FINALLY (h@@, ", p, x);
    Emit.OpSI ("@@);\n", p, x);
  END StartOfFinally;

PROCEDURE MiddleOfFinally (p: Prefix;  x: Label;
                                   VAR(*OUT*) returnSeen, exitSeen: BOOLEAN) =
  BEGIN
    Emit.OpSI ("\002@@:\n\001", p, x);
    Emit.OpSI ("CUT_TO_NEXT_HANDLER (h@@);\n", p, x);
    Pop ();
    returnSeen := stack[tos].returnSeen;
    exitSeen   := stack[tos].exitSeen;
  END MiddleOfFinally;

PROCEDURE EndOfFinally (p: Prefix;  x: Label;  returnSeen, exitSeen: BOOLEAN)=
  VAR
    i: INTEGER;
    o: Outcome;
    p1: Prefix;
    x1: Label;
  BEGIN
    FindOutcome (o);
    Emit.OpSI ("if (h@@.exception != FALL_EXCEPTION) {\001\n", p, x);

    IF (exitSeen) THEN
      i := o.exit;  
      <* ASSERT i # NoHandler *>
      Emit.OpSI ("if (h@@.exception == EXIT_EXCEPTION) {\001\n", p, x);
      p1 := stack[i].prefix;
      x1 := stack[i].label;
      IF (stack[i].kind # Kind.zEXIT) THEN
        Emit.OpSI ("h@@.exception = EXIT_EXCEPTION;\n", p1, x1);
      END;
      Emit.OpSI ("goto @@;\n", p1, x1);
      Emit.Op ("\002};\n");
    END;

    IF (returnSeen) THEN
      i := o.return;
      <* ASSERT i # NoHandler *>
      Emit.OpSI ("if (h@@.exception == RETURN_EXCEPTION) {\001\n", p, x);
      IF (stack[i].kind = Kind.zPROC OR stack[i].kind = Kind.zRAISES) THEN
        DoReturn (i);
      ELSE (* somebody is catching this return! *)
        p1 := stack[i].prefix;
        x1 := stack[i].label;
        Emit.OpSI ("h@@.exception = RETURN_EXCEPTION;\n", p1, x1);
        Emit.OpSI ("goto @@;\n", p1, x1);
      END;
      Emit.Op ("\002};\n");
    END;

    i := o.except;
    IF (i = NoHandler) OR (stack[i].kind = Kind.zPROC) THEN
      Emit.OpSI ("RAISE_FOR_SURE (h@@.exception);\n", p, x);
    ELSE
      p1 := stack[i].prefix;
      x1 := stack[i].label;
      Emit.OpSI ("h@@.exception = ", p1, x1);
      Emit.OpSI ("h@@.exception;\n", p, x);
      Emit.OpSI ("goto @@;\n", p1, x1);
    END;

    Emit.Op ("\002};\n"); (* if (exception != FALL) ... *)
    Emit.Op ("\002};\n"); (* { HANDLER h@@ ....    *)
  END EndOfFinally;

(******************  TRY-EXCEPT  *******************************)

PROCEDURE PushTry (p: Prefix;  x: Label) =
  BEGIN
    Push (Kind.zTRY, p, x);
  END PushTry;

PROCEDURE PushTryElse (p: Prefix;  x: Label) =
  BEGIN
    Push (Kind.zTRYELSE, p, x);
  END PushTryElse;

PROCEDURE EmitElse (p: Prefix;  x: Label) =
  VAR i: INTEGER;  o: Outcome;  p1: Prefix;  x1: Label;
  BEGIN
    FindOutcome (o);
    i := o.except;
    IF (i = NoHandler) OR (stack[i].kind = Kind.zPROC) THEN
      Emit.OpSI ("RAISE_FOR_SURE (h@@.exception);\n", p, x);
    ELSE
      p1 := stack[i].prefix;
      x1 := stack[i].label;
      Emit.OpSI ("h@@.exception = ", p1, x1);
      Emit.OpSI ("h@@.exception;\n", p, x);
      Emit.OpSI ("goto @@;\n", p1, x1);
    END;
  END EmitElse;

(******************  LOOP-EXIT  *******************************)

PROCEDURE PushExit (p: Prefix;  x: Label) =
  BEGIN
    Push (Kind.zEXIT, p, x);
  END PushExit;

PROCEDURE ExitOK (): BOOLEAN =
  BEGIN
    FOR i := tos - 1 TO 0 BY  -1 DO
      IF (stack[i].kind = Kind.zEXIT) THEN RETURN TRUE END;
      IF (stack[i].kind = Kind.zPROC) THEN RETURN FALSE END;
    END;
    RETURN FALSE;
  END ExitOK;

PROCEDURE EmitExit () =
  VAR i: INTEGER;  o: Outcome;  p: Prefix;  x: Label;
  BEGIN
    FindOutcome (o);
    i := o.exit;
    <* ASSERT i # NoHandler AND o.eStop # NoHandler *>
    FOR j := o.eStop TO tos - 1 DO stack[j].exitSeen := TRUE END;
    p := stack[i].prefix;
    x := stack[i].label;
    IF (stack[i].kind # Kind.zEXIT) THEN
      Emit.OpSI ("h@@.exception = EXIT_EXCEPTION;\n", p, x);
    ELSE
      WITH j = FindWhereToCut (i) DO
        IF j # NoHandler THEN
          Emit.OpSI ("CUT_TO_NEXT_HANDLER (h@@);\n",
  		     stack[j].prefix, stack[j].label);
        END;
      END;
    END;
    Emit.OpSI ("goto @@;\n", p, x);
  END EmitExit;

(******************  TRY-PASSING  *******************************)

PROCEDURE PushRaises (p: Prefix;  x: Label) =
  BEGIN
    Push (Kind.zRAISES, p, x);
  END PushRaises;

PROCEDURE StartRaises (p: Prefix;  x: Label;  t: Type.T) =
  VAR r: ProcType.Raisee;  any: BOOLEAN;
  BEGIN
    ProcType.Raises (t, r, any);
    IF ( NOT any) THEN
      Push (Kind.zRAISES, p, x);
      Emit.OpSI ("{\001\nHANDLER h@@;\n", p, x);
      Emit.OpSI ("PUSH_RAISES (h@@, ", p, x);
      Emit.OpI  ("raises_@, ", ProcType.RaisesVar (t));
      Emit.OpSI ("@@);\n", p, x);
    END;
  END StartRaises;

PROCEDURE EndRaises (t: Type.T) =
  VAR
    p     : Prefix;
    x     : Label;
    r     : ProcType.Raisee;
    any   : BOOLEAN;
  BEGIN
    ProcType.Raises (t, r, any);
    IF (any) THEN RETURN END;
    Pop ();
    WITH z = stack[tos] DO
      <* ASSERT z.kind = Kind.zRAISES *>
      p := z.prefix;
      x := z.label;
    END;
    Emit.OpSI ("\002@@:\n\001", p, x);
    Emit.OpSI ("CUT_TO_NEXT_HANDLER (h@@);\n", p, x);
    Emit.OpSI ("if (h@@.exception != 0) ", p, x);
    Emit.OpSI ("RAISE_FOR_SURE (h@@.exception);\n", p, x);
(*
    any := (r # NIL);
    IF any THEN
      Emit.OpSI ("if (h@@.exception == 0) ", p, x);
      Emit.OpSI ("goto hx@@;\n", p, x);
      WHILE (r # NIL) DO
        Emit.OpSI ("if (h@@.exception->e == ", p, x);
        Emit.OpN ("& @) ", r.except);
        Emit.OpSI ("goto hx@@;\n", p, x);
        r := r.next;
      END;
      Emit.OpSI ("RAISESFAULT (h@@.exception->e);\n", p, x);
    ELSE
      Emit.OpSI ("if (h@@.exception != 0) ", p, x);
      Emit.OpSI ("RAISESFAULT (h@@.exception->e);\n", p, x);
    END;
    IF (any) THEN
      Emit.OpSI ("\002hx@@:;\001\n", p, x);
      FindOutcome (o);
      i := o.except;
      <* ASSERT i # NoHandler *>
      p1 := stack[i].prefix;
      x1 := stack[i].label;
      IF (stack[i].kind # Kind.zPROC) THEN
        Emit.OpSI ("h@@.exception = ", p1, x1);
        Emit.OpSI ("h@@.exception;\n", p, x);
        Emit.OpSI ("goto @@;\n", p1, x1);
      END;
    END;
*)
    Emit.Op ("\002};\n");
  END EndRaises;

(******************  PROCEDURES *******************************)

VAR nextReturnLabel := 0;

PROCEDURE PushProcedure (t: Type.T;  v: Variable.T;  inline := FALSE) =
  BEGIN
    <* ASSERT (t = NIL) = (v = NIL) *>
    Push (Kind.zPROC, empty, nextReturnLabel);
    INC (nextReturnLabel);
    WITH z = stack[tos - 1] DO
      z.type := t;
      z.variable := v;
      z.inline := inline;
    END;
  END PushProcedure;

PROCEDURE ReturnOK (): BOOLEAN =
  BEGIN
    FOR i := tos - 1 TO 0 BY  -1 DO
      IF (stack[i].kind = Kind.zPROC) THEN RETURN TRUE END;
    END;
    RETURN FALSE;
  END ReturnOK;

PROCEDURE ReturnVar (VAR(*OUT*) t: Type.T;  VAR(*OUT*) v: Variable.T) =
  BEGIN
    FOR i := tos - 1 TO 0 BY  -1 DO
      IF (stack[i].kind = Kind.zPROC) THEN
        t := stack[i].type;
        v := stack[i].variable;
        RETURN ;
      END;
    END;
    <* ASSERT FALSE *>
  END ReturnVar;

PROCEDURE EmitReturn () =
  VAR i: INTEGER;  p: Prefix;  x: Label;  o: Outcome;
  BEGIN
    FindOutcome (o);
    i := o.return;
    <* ASSERT i # NoHandler AND o.rStop # NoHandler *>
    FOR j := o.rStop TO tos - 1 DO stack[j].returnSeen := TRUE END;
    IF (stack[i].kind = Kind.zPROC OR stack[i].kind = Kind.zRAISES) THEN
      DoReturn (i);
    ELSE
      p := stack[i].prefix;
      x := stack[i].label;
      Emit.OpSI ("h@@.exception = RETURN_EXCEPTION;\n", p, x);
      Emit.OpSI ("goto @@;\n", p, x);
    END;
  END EmitReturn;

PROCEDURE DoReturn (i: INTEGER) =
  BEGIN
    IF stack[i].kind = Kind.zRAISES THEN
      Emit.OpSI ("CUT_TO_NEXT_HANDLER (h@@);\n",
                 stack[i].prefix, stack[i].label);
       DEC (i); END;
    WITH z = stack[i] DO
      IF (z.inline) THEN
        Emit.OpI ("goto return_@;\n", z.label);
      ELSIF (z.type = NIL) THEN
        Emit.Op ("return;\n");
      ELSIF ProcType.LargeResult (z.type) THEN
        Emit.OpV ("*_return = @;\n", z.variable);
        Emit.Op  ("return;\n");
      ELSE
        Emit.OpV ("return @;\n", z.variable);
      END;
    END;
  END DoReturn;

(******************  INTERNAL  *******************************)

PROCEDURE Push (k: Kind;  p: Prefix;  x: Label) =
  BEGIN
    WITH z = stack[tos] DO
      z.kind       := k;
      z.prefix     := p;
      z.label      := x;
      z.returnSeen := FALSE;
      z.exitSeen   := FALSE;
      z.type       := NIL;
      z.variable   := NIL;
    END;
    INC (tos);
  END Push;

PROCEDURE FindOutcome (VAR o: Outcome) =
  VAR i, pending: INTEGER;
  BEGIN
    o.exit   := NoHandler;
    o.eStop  := NoHandler;
    o.return := NoHandler;
    o.rStop  := NoHandler;
    o.except := NoHandler;
    pending := 5;
    i := tos - 1;
    WHILE (pending > 0) AND (i >= 0) DO
      WITH z = stack[i] DO
        CASE z.kind OF
        | Kind.zFINALLY =>
            IF (o.exit = NoHandler)   THEN o.exit := i;   DEC (pending) END;
            IF (o.return = NoHandler) THEN o.return := i; DEC (pending) END;
            IF (o.except = NoHandler) THEN o.except := i; DEC (pending) END;
        | Kind.zEXIT =>
            IF (o.exit = NoHandler)   THEN o.exit := i;   DEC (pending) END;
            IF (o.eStop = NoHandler)  THEN o.eStop := i;  DEC (pending) END;
        | Kind.zTRY =>
            IF (o.except = NoHandler) THEN o.except := i; DEC (pending) END;
        | Kind.zTRYELSE =>
            IF (o.exit = NoHandler)   THEN o.exit := i;   DEC (pending) END;
            IF (o.eStop = NoHandler)  THEN o.eStop := i;  DEC (pending) END;
            IF (o.return = NoHandler) THEN o.return := i; DEC (pending) END;
            IF (o.rStop = NoHandler)  THEN o.rStop := i;  DEC (pending) END;
            IF (o.except = NoHandler) THEN o.except := i; DEC (pending) END;
        | Kind.zRAISES =>
            IF (o.except = NoHandler) THEN o.except := i; DEC (pending) END;
            IF (o.return = NoHandler) THEN o.return := i; DEC (pending) END;
        | Kind.zPROC =>
            IF (o.return = NoHandler) THEN o.return := i; END;
            IF (o.rStop = NoHandler)  THEN o.rStop := i;  END;
            IF (o.except = NoHandler) THEN o.except := i; END;
            pending := 0;
        END;
      END;
      DEC (i);
    END;
  END FindOutcome;

PROCEDURE FindWhereToCut (i: INTEGER): INTEGER =
  BEGIN
    WHILE (i < tos) DO
      IF stack[i].kind = Kind.zTRY OR stack[i].kind = Kind.zRAISES THEN
        RETURN (i);
      END;
      INC (i); 
    END;
    RETURN (NoHandler);
  END FindWhereToCut;

PROCEDURE Initialize () =
  BEGIN
    empty := String.Add ("");
  END Initialize;

BEGIN
END Marker.