m3tk/src/target/M3CBackEnd_Float.mg


GENERIC MODULE M3CBackEnd_Float(FloatType);
Copyright (C) 1991, Digital Equipment Corporation All rights reserved. See the file COPYRIGHT for a full description.

IMPORT M3AST_AS, M3AST_SM, M3CStdProcs;

IMPORT M3CBackEnd;
IMPORT M3CBackEnd_Int_Integer, M3CBackEnd_Int_Longint;
IMPORT M3CBackEnd_Float_Real, M3CBackEnd_Float_LongReal,
       M3CBackEnd_Float_Extended;

PROCEDURE New_value (r: FloatType.T): T RAISES {}=
  BEGIN
    RETURN NEW(T, sm_value := r);
  END New_value;

PROCEDURE UnaryOp (
    op: M3AST_AS.UNARY;
    e: T;
    VAR (*out*) er: M3AST_SM.Exp_value)
  : M3CBackEnd.NumStatus RAISES {}=
  VAR r: FloatType.T;
  BEGIN
    TYPECASE op OF
    | M3AST_AS.Unaryplus =>
	r := e.sm_value;
    | M3AST_AS.Unaryminus =>
	r := -e.sm_value;
    ELSE
        RETURN M3CBackEnd.NumStatus.Unknown;
    END; (* case *)
    er := New_value(r);
    RETURN M3CBackEnd.NumStatus.Valid;
  END UnaryOp;

PROCEDURE StdUnaryOp (
    f: M3CStdProcs.Func;
    e: T;
    VAR (*out*) er: M3AST_SM.Exp_value;
    it: M3AST_AS.INT_TYPE := NIL;
    ft: M3AST_AS.FLOAT_TYPE := NIL)
  : M3CBackEnd.NumStatus RAISES {}=
  VAR
    float: FloatType.T := e.sm_value;
  BEGIN
    CASE f OF
    | M3CStdProcs.T.Abs =>
        er := New_value(ABS(float));
    | M3CStdProcs.T.Float =>
        TYPECASE ft OF <*NOWARN*>
        | M3AST_AS.Real_type =>
  	    er := M3CBackEnd_Float_Real.New_value(FLOAT(float, REAL));
        | M3AST_AS.LongReal_type =>
            er := M3CBackEnd_Float_LongReal.New_value(FLOAT(float, LONGREAL));
        | M3AST_AS.Extended_type =>
            er := M3CBackEnd_Float_Extended.New_value(FLOAT(float, EXTENDED));
        END; (* typecase *)

    | M3CStdProcs.T.Floor =>
        TYPECASE it OF <*NOWARN*>
        | M3AST_AS.Integer_type =>
            er := M3CBackEnd_Int_Integer.New_value(FLOOR(float, INTEGER));
        | M3AST_AS.Longint_type =>
            er := M3CBackEnd_Int_Longint.New_value(FLOOR(float, LONGINT));
        END; (* typecase *)
    | M3CStdProcs.T.Ceiling =>
        TYPECASE it OF <*NOWARN*>
        | M3AST_AS.Integer_type =>
            er := M3CBackEnd_Int_Integer.New_value(CEILING(float, INTEGER));
        | M3AST_AS.Longint_type =>
            er := M3CBackEnd_Int_Longint.New_value(CEILING(float, LONGINT));
        END; (* typecase *)
    | M3CStdProcs.T.Round =>
        TYPECASE it OF <*NOWARN*>
        | M3AST_AS.Integer_type =>
            er := M3CBackEnd_Int_Integer.New_value(ROUND(float, INTEGER));
        | M3AST_AS.Longint_type =>
            er := M3CBackEnd_Int_Longint.New_value(ROUND(float, LONGINT));
        END; (* typecase *)
    | M3CStdProcs.T.Trunc =>
        TYPECASE it OF <*NOWARN*>
        | M3AST_AS.Integer_type =>
            er := M3CBackEnd_Int_Integer.New_value(TRUNC(float, INTEGER));
        | M3AST_AS.Longint_type =>
            er := M3CBackEnd_Int_Longint.New_value(TRUNC(float, LONGINT));
        END; (* typecase *)
    ELSE RETURN M3CBackEnd.NumStatus.Unknown;
    END; (* case *)
    RETURN M3CBackEnd.NumStatus.Valid;
  END StdUnaryOp;

PROCEDURE BinaryOp (
    op: M3AST_AS.BINARY;
    e1, e2: T;
    VAR (*out*) er: M3AST_SM.Exp_value)
  : M3CBackEnd.NumStatus RAISES {}=
  VAR
    float1 := e1.sm_value;
    float2 := e2.sm_value;
    floatr: FloatType.T;
    bool: BOOLEAN;
  BEGIN
    TYPECASE op OF
    | M3AST_AS.Plus =>  floatr := float1 + float2;
    | M3AST_AS.Minus => floatr := float1 - float2;
    | M3AST_AS.Times => floatr := float1 * float2;
    | M3AST_AS.Rdiv =>  floatr := float1 / float2;
    ELSE
      TYPECASE op OF
      | M3AST_AS.Eq => bool := float1 = float2;
      | M3AST_AS.Ne => bool := float1 # float2;
      | M3AST_AS.Gt => bool := float1 > float2;
      | M3AST_AS.Lt => bool := float1 < float2;
      | M3AST_AS.Ge => bool := float1 >= float2;
      | M3AST_AS.Le => bool := float1 <= float2;
      ELSE RETURN M3CBackEnd.NumStatus.Unknown;
      END; (* case *)
      er := M3CBackEnd_Int_Integer.New_value(ORD(bool));
      RETURN M3CBackEnd.NumStatus.Valid;
    END;
    er := New_value(floatr);
    RETURN M3CBackEnd.NumStatus.Valid;
  END BinaryOp;

PROCEDURE StdBinaryOp(
    f: M3CStdProcs.Func;
    e1, e2: T;
    VAR (*out*) er: M3AST_SM.Exp_value)
  : M3CBackEnd.NumStatus RAISES {}=
  BEGIN
    CASE f OF <*NOWARN*>
    | M3CStdProcs.T.Min =>
      IF e1.sm_value < e2.sm_value
        THEN er := e1;
        ELSE er := e2;
      END;
    | M3CStdProcs.T.Max =>
      IF e1.sm_value > e2.sm_value
        THEN er := e1;
        ELSE er := e2;
      END;
    END; (* case *)
    RETURN M3CBackEnd.NumStatus.Valid;
  END StdBinaryOp;

BEGIN

END M3CBackEnd_Float.