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

(* File: SubrangeType.m3                                       *)
(* Last modified on Mon Mar  2 11:21:21 PST 1992 by kalsow     *)
(*      modified on Thu Jan 31 23:22:08 1991 by muller         *)

MODULE SubrangeType;

IMPORT Type, TypeRep, Emit, Int, Expr, Token, Card, MBuf, M3;
IMPORT Error, IntegerExpr, EnumExpr, Target, Word;
FROM Scanner IMPORT Match, Match1;
FROM Target IMPORT MINUCHAR, MAXUCHAR, MINSCHAR, MAXSCHAR;
FROM Target IMPORT MINSHORT, MAXSHORT, MINUSHORT, MAXUSHORT, MAXINT, MININT;

TYPE 
  P = Type.T BRANDED "SubrangeType.T" OBJECT
        baseType   : Type.T;
        minE, maxE : Expr.T;
        min,  max  : INTEGER;
        rep        : Rep;
        sealed     : BOOLEAN;
      OVERRIDES
        check      := Check;
        base       := Baser;
        isEqual    := EqualChk;
        isSubtype  := Subtyper;
        count      := Counter;
        bounds     := Bounder;
        size       := Sizer;
        minSize    := MinSizer;
        alignment  := Aligner;
	isEmpty    := IsEmpty;
        dependsOn  := TypeRep.DependsOnNone;
        compile    := Compiler;
        initCost   := InitCoster;
        initValue  := GenInit;
        mapper     := TypeRep.NoMapper;
        fprint     := FPrinter;
        class      := MyClass;
      END;

TYPE
  Rep = {s_int, s_short, u_short, s_char, u_char};

CONST
  RepMin  = ARRAY Rep OF INTEGER { MININT, MINSHORT, MINUSHORT,
                                   MINSCHAR, MINUCHAR };
  RepMax  = ARRAY Rep OF INTEGER { MAXINT, MAXSHORT, MAXUSHORT,
                                   MAXSCHAR, MAXUCHAR };
  RepSize = ARRAY Rep OF INTEGER { Target.INTSIZE, Target.SHORTSIZE,
                                   Target.SHORTSIZE, Target.CHARSIZE,
                                   Target.CHARSIZE };
  RepAlign = ARRAY Rep OF INTEGER { Target.INTALIGN, Target.SHORTALIGN,
                                   Target.SHORTALIGN, Target.CHARALIGN,
                                   Target.CHARALIGN };
  RepName = ARRAY Rep OF TEXT {"int", "short", "unsigned short",
                               "signed_char", "unsigned char" };

PROCEDURE Parse (READONLY fail: Token.Set): Type.T =
  TYPE TK = Token.T;
  VAR p: P;
  BEGIN
    p := New (0,  -1, NIL);
    Match (TK.tLBRACKET, fail, Token.Set {TK.tRBRACKET} + Token.ExprStart);
    p.minE := Expr.Parse (fail + Token.Set {TK.tDOTDOT, TK.tRBRACKET});
    Match (TK.tDOTDOT, fail, Token.Set {TK.tRBRACKET} + Token.ExprStart);
    p.maxE := Expr.Parse (fail + Token.Set {TK.tRBRACKET});
    Match1 (TK.tRBRACKET, fail);
    RETURN p;
  END Parse;

PROCEDURE New (min, max: INTEGER;  base: Type.T): Type.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    TypeRep.Init (p);
    p.baseType := base;
    p.min      := min;
    p.max      := max;
    p.sealed   := (base # NIL);
    RETURN p;
  END New;

PROCEDURE Split (t: Type.T;  VAR min, max: INTEGER): BOOLEAN =
  BEGIN
    TYPECASE Type.Strip (t) OF
    | NULL => RETURN FALSE;
    | P(p) => min := p.min;  max := p.max;  RETURN TRUE;
    ELSE      RETURN FALSE;
    END;
  END Split;

PROCEDURE SetSize (t: Type.T; size: INTEGER) =
  BEGIN
    Seal (t);
    SetRep (t, size);
  END SetSize;

PROCEDURE SetRep (p: P; size := 0) =
  BEGIN
    IF (p.min > p.max) THEN  
      p.min := 0; p.max := -1; p.rep := Rep.s_int;
    ELSE
      VAR m := p.min; M := p.max;
      BEGIN
        IF (size < 0) THEN
          IF    size >= -Target.CHARSIZE        THEN p.rep := Rep.s_char;
          ELSIF size >= -Target.SHORTSIZE       THEN p.rep := Rep.s_short;
          ELSE                                       p.rep := Rep.s_int; END;
        ELSIF (size > 0) THEN
          IF    size <= Target.CHARSIZE         THEN p.rep := Rep.u_char;
          ELSIF size <= Target.SHORTSIZE        THEN p.rep := Rep.u_short;
          ELSE                                       p.rep := Rep.s_int; END;
        ELSIF MINSCHAR <= m  AND M <= MAXSCHAR  THEN p.rep := Rep.s_char;
        ELSIF MINUCHAR <= m  AND M <= MAXUCHAR  THEN p.rep := Rep.u_char;
        ELSIF MINSHORT <= m  AND M <= MAXSHORT  THEN p.rep := Rep.s_short;
        ELSIF MINUSHORT <= m AND M <= MAXUSHORT THEN p.rep := Rep.u_short;
        ELSE                                         p.rep := Rep.s_int; END;
      END;
    END;
  END SetRep;

PROCEDURE Seal (p: P) =
  VAR emin, emax: Expr.T;  tmin, tmax: Type.T;
  BEGIN
    IF (p.sealed) THEN RETURN END;
    IF (p.minE # NIL) THEN
      emin := Expr.ConstValue (p.minE);
      IF (emin = NIL) THEN
        Error.Msg ("subrange lower bound is not constant");
        p.min := 0;  tmin := Int.T;
      ELSIF IntegerExpr.Split (emin, p.min) THEN
        tmin := Int.T;
      ELSIF EnumExpr.Split (emin, p.min, tmin) THEN
        (* Ok *)
      ELSE
        Error.Msg ("subrange lower bound is not an ordinal value");
        p.min := 0;  tmin := Int.T;
      END;

      emax := Expr.ConstValue (p.maxE);
      IF (emax = NIL) THEN
        Error.Msg ("subrange upper bound is not constant");
        p.max := p.min;  tmax := tmin;
      ELSIF IntegerExpr.Split (emax, p.max) THEN
        tmax := Int.T;
      ELSIF EnumExpr.Split (emax, p.max, tmax) THEN
        (* Ok *)
      ELSE
        Error.Msg ("subrange upper bound is not an ordinal value");
        p.max := p.min;  tmax := tmin;
      END;

      p.baseType := tmin;
      IF NOT Type.IsEqual (tmin, tmax, NIL) THEN
        Error.Msg ("subrange endpoints must be of same type");
      END;
    END;

    SetRep (p);
    p.sealed := TRUE;
  END Seal;

PROCEDURE MyClass (<*UNUSED*> p: P): TypeRep.Class =
  BEGIN
    RETURN TypeRep.Class.Subrange;
  END MyClass;

PROCEDURE Check (p: P) =
  VAR hash: INTEGER;  cs := M3.OuterCheckState;
  BEGIN
    Seal (p);
    Expr.TypeCheck (p.minE, cs);
    Expr.TypeCheck (p.maxE, cs);
    Type.Check (p.baseType);

    hash := p.baseType.hash;
    hash := Word.Plus (Word.Times (hash, 487), p.min);
    hash := Word.Plus (Word.Times (hash, 487), p.max);
    p.hash := hash;
  END Check;

PROCEDURE Compiler (p: P) =
  VAR rep := RepName [p.rep];
  BEGIN
    Emit.OpF ("\003#define @ ", p);
    Emit.OpX ("@\n", rep);
    Type.Compile (p.baseType);

    IF TypeRep.StartLinkInfo (p) THEN RETURN END;

    Emit.OpF ("d@\n", p.baseType);

    Emit.Op  ("C\n");
    Emit.OpF ("\003#define @ ", p);
    Emit.OpX ("@\n", rep);
    Emit.Op  ("*\n");
  END Compiler;

PROCEDURE Baser (p: P): Type.T =
  BEGIN
    IF (p.baseType # NIL)
      THEN RETURN Type.Base (p.baseType);
      ELSE RETURN Type.Base (Expr.TypeOf (p.minE))
    END;
  END Baser;

PROCEDURE Bounder (p: P;  VAR min, max: INTEGER): BOOLEAN =
  BEGIN
    Seal (p);
    min := p.min;
    max := p.max;
    RETURN TRUE;
  END Bounder;

PROCEDURE EqualChk (a: P;  t: Type.T;  x: Type.Assumption): BOOLEAN =
  BEGIN
    TYPECASE Type.Strip (t) OF 
    | NULL => RETURN FALSE;
    | P(b) => Seal (a);  Seal (b);
              RETURN (a.min = b.min)
                 AND (a.max = b.max)
		 AND Type.IsEqual (a.baseType, b.baseType, x);
    ELSE      RETURN FALSE;
    END;
  END EqualChk;

PROCEDURE Subtyper (a: P;  t: Type.T): BOOLEAN =
  BEGIN
    Seal (a);
    IF NOT Type.IsEqual(Type.Base(a.baseType), Type.Base(t), NIL) THEN
      RETURN FALSE
     END;
    IF (a.min > a.max) THEN (* a is empty *) RETURN TRUE END;
    TYPECASE Type.Strip (t) OF
    | NULL => RETURN FALSE;
    | P(b) => RETURN (b.min <= a.min) AND (a.max <= b.max);
    ELSE      RETURN TRUE;
    END;
  END Subtyper;

PROCEDURE Counter (p: P): INTEGER =
  BEGIN
    Seal (p);
    RETURN MAX (0, p.max - p.min + 1);
  END Counter;

PROCEDURE Sizer (p: P): INTEGER =
  BEGIN
    Seal (p);
    RETURN RepSize [p.rep];
  END Sizer;

PROCEDURE MinSizer (p: P): INTEGER =
  VAR z: INTEGER;
  BEGIN
    (* compute the minimum size of these elements *)
    Seal (p);
    IF (p.min > p.max) THEN RETURN 0 END;
    z := BitWidth (p.max);
    IF (p.min < 0) THEN z := 1 + MAX (z, BitWidth ( -(p.min + 1)));  END;
    RETURN z;
  END MinSizer;

PROCEDURE BitWidth (n: INTEGER): INTEGER =
  (***  valid for  0 <= n <= 2^32-1 ***)
  VAR width: INTEGER;
  BEGIN
    <* ASSERT n >= 0 *>
    (* a binary search on the width: *)
    width := 0;
    IF (n >= 65536) THEN n := n DIV 65536; INC (width, 16) END;
    IF (n >= 256)   THEN n := n DIV 256;   INC (width, 8)  END;
    IF (n >= 16)    THEN n := n DIV 16;    INC (width, 4)  END;
    IF (n >= 4)     THEN n := n DIV 4;     INC (width, 2)  END;
    IF (n >= 2)     THEN n := n DIV 2;     INC (width, 1)  END;
    IF (n >= 1)     THEN                   INC (width, 1)  END;
    RETURN width;
  END BitWidth;

PROCEDURE Aligner (p: P): INTEGER =
  BEGIN
    Seal (p);
    RETURN RepAlign [p.rep];
  END Aligner;

PROCEDURE IsEmpty (p: P): BOOLEAN =
  BEGIN
    Seal (p);
    RETURN (p.min > p.max);
  END IsEmpty;

PROCEDURE InitCoster (p: P;  zeroed: BOOLEAN): INTEGER =
  BEGIN
    Seal (p);
    IF zeroed AND p.min <= 0 AND 0 <= p.max THEN
      RETURN 0;
    ELSIF (p.min <= RepMin[p.rep]) AND (RepMax[p.rep] <= p.max) THEN
      RETURN 0;
    ELSE
      RETURN 1;
    END;
  END InitCoster;

PROCEDURE GenInit (p: P) =
  BEGIN
    IF (p.min <= 0) AND (0 <= p.max)
      THEN Emit.Op ("0");
      ELSE Emit.OpI ("@", p.min);
    END;
  END GenInit;

PROCEDURE FPrinter (p: P;  map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    IF Type.IsEqual (p, Card.T, NIL) THEN
      MBuf.PutText (wr, "$cardinal");
    ELSE
      MBuf.PutText (wr, "SUBRANGE ");
      MBuf.PutInt  (wr, p.min);
      MBuf.PutText (wr, " ");
      MBuf.PutInt  (wr, p.max);
      MBuf.PutText (wr, " ");
      Type.Fingerprint (p.baseType, map, wr);
    END;
  END FPrinter;

BEGIN
END SubrangeType.