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

(* File: Value.m3                                              *)
(* Last modified on Thu Nov  5 15:42:29 PST 1992 by kalsow     *)
(*      modified on Wed Mar 27 03:00:56 1991 by muller         *)

MODULE Value EXPORTS Value, ValueRep;

IMPORT Type, Expr, Error, MBuf, Module, Temp, Emit, Scope;
IMPORT Variable, Void, Scanner, Host, String, Revelation;

CONST NOT_CHECKED = -1;
CONST CHECKED     = 0;

PROCEDURE TypeCheck (t: T;  VAR cs: CheckState) =
  VAR save: INTEGER;
  BEGIN
    IF (t = NIL) THEN RETURN END;
    IF (t.checked) THEN RETURN END;
    IF (t.checkDepth = NOT_CHECKED) THEN
      (* this node is not currently being checked *)
      save := Scanner.offset;
      Scanner.offset := t.origin;
        t.checkDepth := Type.recursionDepth;
        t.typeCheck (cs);
        t.checkDepth := CHECKED;
        t.checked := TRUE;
      Scanner.offset := save;
    ELSIF (t.checkDepth # Type.recursionDepth) THEN
      (* this is a legal recursion, just return *)
    ELSE
      IllegalRecursion (t);
    END;
  END TypeCheck;

PROCEDURE TypeOf (t: T): Type.T =
  VAR x: Type.T;
  BEGIN
    IF (t = NIL) THEN RETURN Void.T END;
    IF (t.inTypeOf) THEN IllegalRecursion (t);  RETURN Void.T  END;
    t.inTypeOf := TRUE;
    x := t.typeOf ();
    t.inTypeOf := FALSE;
    RETURN x;
  END TypeOf;

PROCEDURE Load (t: T): Temp.T =
  BEGIN
    IF (t = NIL) THEN RETURN Temp.FromValue (NIL) END;
    <* ASSERT t.checked *>
    t.used :=TRUE;
    RETURN t.load ();
  END Load;

PROCEDURE Write (t: T) =
  BEGIN
    IF (t # NIL) THEN
      <* ASSERT t.checked *>
      t.write ();
    END;
  END Write;

PROCEDURE ToExpr (t: T): Expr.T =
  VAR e: Expr.T;
  BEGIN
    IF (t = NIL) THEN RETURN NIL END;
    IF (t.inToExpr) THEN IllegalRecursion (t); RETURN NIL END;
    t.inToExpr := TRUE;
    e := t.toExpr ();
    t.inToExpr := FALSE;
    RETURN e;
  END ToExpr;

PROCEDURE ToType (t: T): Type.T =
  VAR x: Type.T;
  BEGIN
    IF (t = NIL) THEN RETURN NIL END;
    IF (t.inToType) THEN IllegalRecursion (t); RETURN NIL END;
    t.inToType := TRUE;
    x := t.toType ();
    t.inToType := FALSE;
    RETURN x;
  END ToType;

PROCEDURE Base (t: T): T =
  BEGIN
    IF (t = NIL) THEN RETURN NIL END;
    RETURN t.base ();
  END Base;

PROCEDURE IllegalRecursion (t: T) =
  BEGIN
    IF (NOT t.error) THEN
      Error.Str (t.name, "illegal recursive declaration");
      t.error := TRUE;
    END;
  END IllegalRecursion;

PROCEDURE ClassOf (t: T): Class =
  BEGIN
    IF (t = NIL) THEN RETURN Class.Error END;
    RETURN t.class ();
  END ClassOf;

TYPE SC = { Exported, Imported, Global, Local, LocalProc };

PROCEDURE StorageClass (t: T): SC =
  BEGIN
    IF (t.imported) THEN
      <* ASSERT NOT t.exported *>
      RETURN SC.Imported;
    ELSIF (t.exported) THEN
      <* ASSERT NOT t.imported *>
      RETURN SC.Exported;
    ELSIF (t.class () = Class.Procedure) THEN
      RETURN SC.LocalProc;
    ELSIF Scope.OuterMost (t.scope) THEN
      RETURN SC.Global;
    ELSE
      RETURN SC.Local;
    END;
  END StorageClass;

PROCEDURE GenStorageClass (t: T;  isVolatile: BOOLEAN) =
  VAR vol: TEXT := "";
  BEGIN
    IF isVolatile THEN vol := "_VOLATILE " END;
    IF t.external THEN
      Emit.OpX ("_IMPORT @", vol);
    ELSE
      CASE StorageClass (t) OF
      | SC.Exported  => Emit.OpX ("_EXPORT @", vol);
      | SC.Imported  => Emit.OpX ("_IMPORT @", vol);
      | SC.Global    => Emit.OpX ("_PRIVATE @", vol);
      | SC.LocalProc => Emit.Op  ("_LOCAL_PROC ");
      | SC.Local     => Emit.Op  ("_LOCAL ");
      END;
    END;
  END GenStorageClass;

PROCEDURE GenVSClass (t: T;  sc: SC) =
  BEGIN
    IF t.external THEN
      IF (t.exported) 
        THEN Emit.Op ("e");
        ELSE Emit.Op ("i");
      END;
    ELSE
      CASE sc OF
      | SC.Exported  => Emit.Op ("e");
      | SC.Imported  => Emit.Op ("i");
      | SC.Global    => <* ASSERT FALSE *>
      | SC.Local     => <* ASSERT FALSE *>
      | SC.LocalProc => <* ASSERT FALSE *>
      END;
    END;
  END GenVSClass;

VAR
  fpWriter : MBuf.T;
  fpBusy   : BOOLEAN;

PROCEDURE Declare0 (t: T) =
  VAR class: SC;  save: Emit.Stream;
  BEGIN
    IF (t = NIL) THEN RETURN END;
    IF (t.declared) THEN RETURN END;
    class := StorageClass (t);
    IF (NOT t.used) AND (class = SC.Imported) THEN RETURN END;
    t.declared := TRUE;
    IF t.declare0 () AND (Host.versionStamps)
      AND ((class = SC.Imported) OR (class = SC.Exported)) THEN
      save := Emit.Switch (Emit.Stream.VersionStamps);
      <* ASSERT NOT fpBusy *>
      fpBusy := TRUE;
      IF (fpWriter = NIL) THEN fpWriter := MBuf.New () END;
      Fingerprint (t, NIL, fpWriter);
      t.fprint := MBuf.ToFPrint (fpWriter);

      GenVSClass (t, class);
      Scope.GenName (t, dots := TRUE);
      Emit.OpHH (" @@\n", t.fprint[0], t.fprint[1]);

      fpBusy := FALSE;
      EVAL Emit.Switch (save);
    END;
  END Declare0;

PROCEDURE Declare1 (t: T) =
  VAR save: INTEGER;
  BEGIN
    IF (t = NIL) THEN RETURN END;
    IF (t.compiled) THEN RETURN END;
    <* ASSERT t.checked *>
    save := Scanner.offset;
    Scanner.offset := t.origin;
    t.declare1 ();
    Scanner.offset := save;
    t.compiled := TRUE;
  END Declare1;

PROCEDURE Declare2 (t: T) =
  VAR save: INTEGER;
  BEGIN
    IF (t = NIL) THEN RETURN; END;
    save := Scanner.offset;
    Scanner.offset := t.origin;
    t.declare2 ();
    Scanner.offset := save;
  END Declare2;

PROCEDURE Fingerprint (t: T;  map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    IF (t = NIL) THEN RETURN END;
    t := Base (t);
    MBuf.PutText (wr, "<");
    String.Put (wr, t.name);
    MBuf.PutText (wr, ": ");
    t.fingerprint (map, wr);
    MBuf.PutText (wr, ">");
  END Fingerprint;

VAR all: T;

PROCEDURE Init (t: T;  name: String.T) =
  BEGIN
    t.origin     := Scanner.offset;
    t.name       := name;
    t.extName    := NIL;
    t.scope      := NIL;
    t.next       := all;   all := t;
    t.checkDepth := NOT_CHECKED;
    t.checked    := FALSE;
    t.readonly   := FALSE;
    t.declared   := FALSE;
    t.compiled   := FALSE;
    t.imported   := (Module.depth # 1);
    t.exported   := FALSE;
    t.exportable := FALSE;
    t.external   := FALSE;
    t.used       := FALSE;
    t.unused     := FALSE;
    t.obsolete   := FALSE;
    t.inFrame    := FALSE;
    t.inTypeOf   := FALSE;
    t.inToExpr   := FALSE;
    t.inToType   := FALSE;
    t.error      := FALSE;
    t.fprint[0]  := 0;
    t.fprint[1]  := 0;
  END Init;

PROCEDURE NoExpr (<*UNUSED*> t: T): Expr.T =
  BEGIN
    <* ASSERT FALSE *>
  END NoExpr;

PROCEDURE NoType (<*UNUSED*> t: T): Type.T =
  BEGIN
    <* ASSERT FALSE *>
  END NoType;

PROCEDURE NoLoader (<*UNUSED*> t: T): Temp.T =
  BEGIN
    <* ASSERT FALSE *>
  END NoLoader;

PROCEDURE NoWriter (<*UNUSED*> t: T) =
  BEGIN
    <* ASSERT FALSE *>
  END NoWriter;

PROCEDURE NoDeclarer (<*UNUSED*> t: T) =
  BEGIN
  END NoDeclarer;

PROCEDURE Never (<*UNUSED*> t: T): BOOLEAN =
  BEGIN
    RETURN FALSE;
  END Never;

PROCEDURE Always (<*UNUSED*> t: T): BOOLEAN =
  BEGIN
    RETURN TRUE;
  END Always;

PROCEDURE TypeVoid (<*UNUSED*> t: T): Type.T =
  BEGIN
    RETURN Void.T;
  END TypeVoid;

PROCEDURE Self (t: T): T =
  BEGIN
    RETURN t;
  END Self;

PROCEDURE Initialize () =
  BEGIN
    Variable.Initialize ();
    Revelation.Initialize ();
  END Initialize;

PROCEDURE Reset () =
  VAR t: T;
  BEGIN
    fpBusy := FALSE;
    t := all;
    WHILE (t # NIL) DO
      t.declared := FALSE;
      t.compiled := FALSE;
      t.imported := (NOT Host.emitBuiltins);
      t.exported := FALSE;
      t.used     := FALSE;
      t.inTypeOf := FALSE;
      t.inToExpr := FALSE;
      t.inToType := FALSE;
      t.error    := FALSE;
      t := t.next;
    END;
  END Reset;

PROCEDURE IsExternal (t: T): BOOLEAN =
  BEGIN
    RETURN (t.external);
  END IsExternal;

PROCEDURE IsImported (t: T): BOOLEAN =
  BEGIN
    RETURN (t # NIL) AND (t.imported);
  END IsImported;

PROCEDURE IsWritable (t: T): BOOLEAN =
  BEGIN
    RETURN NOT t.readonly;
  END IsWritable;

PROCEDURE CName (t: T): String.T =
  BEGIN
    IF (t = NIL) THEN RETURN NIL END;
    RETURN t.base().name;
  END CName;

BEGIN
END Value.