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

(* File: Floatt.m3                                             *)
(* Last Modified On Tue Jun 30 08:51:45 PDT 1992 By kalsow     *)
(*      Modified On Sat Dec  8 00:54:23 1990 By muller         *)

MODULE Floatt;

IMPORT CallExpr, Expr, Type, Procedure, Emit, Reel, LReel, EReel, Int;
IMPORT Error, ReelExpr, Temp, TypeExpr;

VAR Z: CallExpr.MethodList;

PROCEDURE TypeOf (<*UNUSED*> proc: Expr.T; VAR args: Expr.List): Type.T =
  VAR u: Type.T;
  BEGIN
    u := Reel.T;
    IF (NUMBER (args^) > 1) THEN
      EVAL TypeExpr.Split (args[1], u);
    END;
    RETURN Type.Base (u);
  END TypeOf;

PROCEDURE Check (<*UNUSED*> proc: Expr.T; VAR args: Expr.List;  <*UNUSED*> VAR cs: Expr.CheckState): Type.T =
  VAR t, u: Type.T;  e: Expr.T;
  BEGIN
    e := args[0];

    u := Reel.T;
    IF (NUMBER (args^) > 1) THEN
      IF NOT TypeExpr.Split (args[1], u) THEN
        Error.Msg ("FLOAT: second argument must be a floating point type");
      END;
      u := Type.Base (u);
    END;

    t := Type.Base (Expr.TypeOf (args[0]));
    IF (t # Int.T) AND (t # Reel.T) AND (t # LReel.T) AND (t # EReel.T) THEN
      Error.Msg ("FLOAT: wrong first argument type");
    END;

    IF (u # Reel.T) AND (u # LReel.T) AND (u # EReel.T) THEN
      Error.Msg ("FLOAT: wrong second argument type");
    END;

    RETURN u;
  END Check;

PROCEDURE Compile (<*UNUSED*> proc: Expr.T; args: Expr.List): Temp.T =
  VAR t, u: Type.T; e: Expr.T; t1, t2: Temp.T;
  BEGIN
    e := args[0];
    t := Type.Base (Expr.TypeOf (e));
    u := Reel.T;
    IF (NUMBER (args^) > 1) THEN
      EVAL TypeExpr.Split (args[1], u);
      u := Type.Base (u);
    END;

    t1 := Expr.Compile (e);
    t2 := Temp.AllocEmpty (u);
    Emit.OpT ("@ = ", t2);
    IF (u = t) THEN
      Emit.OpT ("@;\n", t1);
    ELSIF (u = Reel.T) THEN
      IF    (t = Int.T)   THEN Emit.OpT ("_CVTIF (@);\n", t1);
      ELSIF (t = LReel.T) THEN Emit.OpT ("_CVTLF (@);\n", t1);
      ELSE (*t = EReel.T*)     Emit.OpT ("_CVTEF (@);\n", t1);
      END;
    ELSIF (u = LReel.T) THEN
      IF    (t = Int.T)   THEN Emit.OpT ("_CVTIL (@);\n", t1);
      ELSIF (t = Reel.T)  THEN Emit.OpT ("_CVTFL (@);\n", t1);
      ELSE (*t = EReel.T*)     Emit.OpT ("_CVTEL (@);\n", t1);
      END;
    ELSE (*u = EReel.T*)
      IF    (t = Int.T)   THEN Emit.OpT ("_CVTIE (@);\n", t1);
      ELSIF (t = LReel.T) THEN Emit.OpT ("_CVTLE (@);\n", t1);
      ELSE (*t = Reel.T*)      Emit.OpT ("_CVTFE (@);\n", t1);
      END;
    END;
    Temp.Free (t1);
    RETURN t2;
  END Compile;

PROCEDURE Fold (<*UNUSED*> proc: Expr.T; args: Expr.List): Expr.T =
  VAR e, x: Expr.T;  t: Type.T;
  BEGIN
    e := Expr.ConstValue (args[0]);
    IF (e = NIL) THEN RETURN NIL END;

    t := Reel.T;
    IF (NUMBER (args^) > 1) THEN
      IF NOT TypeExpr.Split (args[1], t) THEN RETURN NIL END;
    END;

    IF ReelExpr.Float (e, t, x)
      THEN  RETURN x;
      ELSE  RETURN NIL;
    END;
  END Fold;

PROCEDURE Initialize () =
  BEGIN
    Z := CallExpr.NewMethodList (1, 2, TRUE, FALSE, NIL,
                                 TypeOf, Check, Compile, Fold,
                                 CallExpr.IsNever, (* writable *)
                                 CallExpr.IsNever, (* designator *)
                                 CallExpr.NotWritable (* noteWriter *));
    Procedure.Define ("FLOAT", Z, TRUE);
  END Initialize;

BEGIN
END Floatt.