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

(* File: Temp.m3                                               *)
(* Last Modified On Mon Feb 24 13:45:48 PST 1992 By kalsow     *)
(*      Modified On Fri Feb 16 07:39:00 1990 By muller         *)

MODULE Temp;

IMPORT M3, Expr, Type, Emit, Value, Frame;

CONST
  MAXTEMPS  = 10000;
  MAXSETS   =   400;

REVEAL
  M3.Temp = UNTRACED BRANDED REF RECORD
    id     : INTEGER;
    value  : Expr.T;
    type   : Type.T;
    uses   : INTEGER;
    obj    : Value.T;
    class  : Class;
    printE : Expr.T;
    lValue : BOOLEAN;
    d1, d2 : T;
  END;

TYPE
  Class = {free, temp, expr, value, macro};

VAR
  x     : ARRAY [0..MAXTEMPS] OF T;
  s     : ARRAY [0..MAXSETS] OF INTEGER;
  topX  : INTEGER := 0;
  topS  : INTEGER := 0;


PROCEDURE LookUp (e: Expr.T;  lValue: BOOLEAN;  VAR t: T): BOOLEAN =
  BEGIN
    (* search the current set for a common subexpression *)
    FOR i := s[topS - 1] TO topX - 1 DO
      WITH z = x[i]^ DO
        IF ((z.class = Class.temp) OR (z.class = Class.macro))
	  AND (z.value # NIL)
	  AND ((NOT lValue) OR (z.lValue))
          AND Expr.IsEqual (z.value, e) THEN
	  t := x[i];
          INC (z.uses);
          RETURN TRUE;
        END;
      END;
    END;
    RETURN FALSE;
  END LookUp;

PROCEDURE Alloc (e: Expr.T): T =
  VAR t := FindFree (Expr.TypeOf (e));
  BEGIN
    <* ASSERT e # NIL *>
    t.class := Class.temp;
    t.value := e;
    t.lValue := FALSE;
    RETURN t;
  END Alloc;

PROCEDURE AllocEmpty (tipe: Type.T;  lValue: BOOLEAN := FALSE): T =
  VAR t := FindFree (tipe);
  BEGIN
    t.class := Class.temp;
    t.value := NIL;
    t.lValue := lValue;
    RETURN t;
  END AllocEmpty;

PROCEDURE AllocMacro (e: Expr.T;  lValue: BOOLEAN := FALSE): T =
  VAR t := FindFree (NIL);
  BEGIN
    <* ASSERT e # NIL *>
    t.class  := Class.macro;
    t.value  := e;
    t.lValue := lValue;
    t.printE := e;
    RETURN t;
  END AllocMacro;

PROCEDURE FromExpr (e: Expr.T): T =
  VAR t := FindFree (NIL);
  BEGIN
    <* ASSERT e # NIL *>
    t.class  := Class.expr;
    t.value  := e;
    t.lValue := FALSE;
    t.printE := e;
    RETURN t;
  END FromExpr;

PROCEDURE FromValue (v: Value.T;  lValue: BOOLEAN := FALSE): T =
  VAR t := FindFree (NIL);
  BEGIN
    <* ASSERT v # NIL *>
    t.class  := Class.value;
    t.value  := NIL;
    t.lValue := lValue;
    t.obj    := v;
    RETURN t;
  END FromValue;

PROCEDURE FindFree (tipe: Type.T): T =
  VAR i, i0, tName: INTEGER;  save: Emit.Stream;
  BEGIN
    IF (x[topX] = NIL) THEN x[topX] := NEW (T) END;
    WITH z = x[topX]^ DO
      z.id     := topX;
      z.value  := NIL;
      z.type   := NIL;
      z.uses   := 0;
      z.obj    := NIL;
      z.class  := Class.free;
      z.lValue := FALSE;
      z.printE := NIL;
      z.d1     := NIL;
      z.d2     := NIL;
    END;

    (* search the current set for a free temporary *)
    i := s[topS - 1];  i0 := i;
    IF (tipe = NIL) THEN
      WHILE (x[i].class # Class.free) DO INC (i) END;
    ELSE
      tName := Type.Name (tipe);
      LOOP
        WITH z = x[i]^ DO
          IF (z.class = Class.free) THEN
	    IF (z.type = NIL) THEN
              (* we're allocating a new typed temporary *)
              (* => write a declaration *)
              z.type := tipe;
              save := Emit.SwitchToDecls ();
              Type.Compile (tipe);
              Emit.OpF ("@ ", tipe);
              Emit.OpI ("_z@;\n", i);
              Frame.NoteDeclaration (tipe);
              EVAL Emit.Switch (save);
	      EXIT;
	    ELSIF (tName = Type.Name (z.type)) THEN
	      (* we can reuse this free temporary *)
              EXIT;
	    END;
          END;
        END;
        INC (i);
      END;
    END;

    <* ASSERT i <= topX *>
    IF (i = topX) THEN INC (topX) END;
    WITH z = x[i]^ DO
      z.uses := 1;
    END;
    RETURN x[i];
  END FindFree;

PROCEDURE Free (t: T) =
  BEGIN
    WITH z = t^ DO
      <* ASSERT (s[topS - 1] <= z.id) AND (z.id < topX) *>
      <* ASSERT z.uses > 0 *>
      DEC (z.uses);
      IF (z.uses <= 0) THEN
        z.class := Class.free;
        IF (z.d1 # NIL) THEN Free (z.d1);  z.d1 := NIL;  END;
        IF (z.d2 # NIL) THEN Free (z.d2);  z.d2 := NIL;  END;
      END;
    END;
  END Free;

PROCEDURE Depend (a, b: T) =  (* free a -> free b *)
  BEGIN
    IF (a.d1 = NIL) THEN a.d1 := b; RETURN END;
    IF (a.d2 = NIL) THEN a.d2 := b; RETURN END;
    <* ASSERT FALSE *> (* no more than 2 dependencies *)
  END Depend;

PROCEDURE IsLValue (t: T): BOOLEAN =
  BEGIN
    RETURN (t.lValue);
  END IsLValue;

PROCEDURE PushSet () =
  BEGIN
    s[topS] := topX;
    INC (topS);
  END PushSet;

PROCEDURE PopSet () =
  BEGIN
    <* ASSERT topS > 0 *>
    FOR i := s[topS - 1] TO topX - 1 DO 
      <* ASSERT x[i].uses = 0 *>
    END;
    DEC (topS);
    topX := s[topS];
  END PopSet;

PROCEDURE KillValues () =
  BEGIN
    FOR i := s[topS - 1] TO topX - 1 DO
      WITH z = x[i]^ DO
        IF (z.class = Class.temp) OR (z.class = Class.macro) THEN
          x[i].value := NIL;
        END;
      END;
    END;
  END KillValues;

PROCEDURE Write (t: T) =
  BEGIN
    CASE t.class OF
    | Class.temp  =>  Emit.OpI ("_z@", t.id);
    | Class.macro =>  Expr.Write (t.printE, t.d1, t.d2);
    | Class.expr  =>  Expr.Write (t.printE, t.d1, t.d2);
    | Class.value =>  Value.Write (t.obj);
    ELSE <* ASSERT FALSE *>
    END;
  END Write;

PROCEDURE Reset () =
  BEGIN
    topX := 0;
    topS := 0;
  END Reset;

BEGIN
END Temp.