MODULE Brand;

IMPORT M3, Expr, M3String, M3WString, M3Buf, Scanner, Module;
IMPORT TextExpr, Target, Type, Token, M3ID, Error, CG, Word;

REVEAL
  T = BRANDED "Brand.T" REF RECORD
    origin: INTEGER     := 0;
    type  : Type.T      := NIL;
    expr  : Expr.T      := NIL;
    val8  : M3String.T  := NIL;
    val16 : M3WString.T := NIL;
    next  : T           := NIL;
    error : BOOLEAN     := FALSE;
  END;

VAR brand_buf  : M3Buf.T := NIL;
VAR all_brands : ARRAY [0..97] OF T;

PROCEDURE Reset () =
  VAR t, u: T;
  BEGIN
    FOR i := FIRST (all_brands) TO LAST (all_brands) DO
      t := all_brands[i];
      WHILE (t # NIL) DO
        u := t.next;
        t.next  := NIL;
        t.error := FALSE;
        t := u;
      END;
      all_brands[i] := NIL;
    END;
  END Reset;

PROCEDURE Parse (): T =
  VAR t: T := NIL;
  BEGIN
    IF (Scanner.cur.token = Token.T.tBRANDED) THEN
      t := NEW (T, origin := Scanner.offset);
      Scanner.GetToken (); (* BRANDED *)
      IF (Scanner.cur.token IN Token.ExprStart)
        THEN t.expr := Expr.Parse ();
        ELSE t.expr := GenerateBrand ();
      END;
    END;
    RETURN t;
  END Parse;

PROCEDURE New (txt: TEXT): T =
  VAR t := NEW (T);
  BEGIN
    t.origin := Scanner.offset;
    t.expr   := TextExpr.New8 (M3String.Add (txt));
    RETURN t;
  END New;

PROCEDURE GenerateBrand (): Expr.T =
  CONST Suffix = ARRAY BOOLEAN OF CHAR { 'M', 'I' };
  VAR counter: ARRAY [0..4] OF CHAR;
  BEGIN
    Module.GetNextCounter (counter);

    (* build the string *)
    IF (brand_buf = NIL) THEN brand_buf := M3Buf.New (); END;
    M3ID.Put      (brand_buf, Module.Name (NIL));
    M3Buf.PutText (brand_buf, " # AuTo-BrAnD # ");
    M3Buf.PutSub  (brand_buf, counter);
    M3Buf.PutChar (brand_buf, Suffix [Module.IsInterface ()]);

    RETURN TextExpr.New8 (M3String.Add (M3Buf.ToText (brand_buf)));
  END GenerateBrand;

PROCEDURE Check (t: T;  holder: Type.T;
                 VAR hash: INTEGER;  VAR cs: Expr.CheckState) =
  VAR e: Expr.T;  xx: INTEGER;
  BEGIN
    IF (t = NIL) THEN RETURN; END;
    t.type := holder;
    Expr.TypeCheck (t.expr, cs);
    e := Expr.ConstValue (t.expr);
    IF (e = NIL) THEN
      Error.Msg ("brand is not a constant");
    ELSIF TextExpr.Split8 (e, t.val8) THEN
      t.expr := e;
      xx := M3String.Hash (t.val8);
      hash := Word.Plus (Word.Times (hash, 37), xx);
      CheckDuplicate (t, xx);
    ELSIF TextExpr.Split16 (e, t.val16) THEN
      t.expr := e;
      xx := M3WString.Hash (t.val16);
      hash := Word.Plus (Word.Times (hash, 37), xx);
      CheckDuplicate (t, xx);
    ELSE
      Error.Msg ("brand is not a TEXT constant");
    END;
  END Check;

PROCEDURE CheckDuplicate (t: T;  hash: INTEGER) =
  VAR cell : INTEGER := hash MOD NUMBER (all_brands);
  VAR node : T       := all_brands[cell];
  BEGIN
    LOOP
      IF (node = NIL) THEN
        (* add an entry to the table *)
        t.next := all_brands[cell];
        all_brands[cell] := t;
        RETURN;
      ELSIF (node = t) OR (node.type = t.type) THEN
        (* ok, this is a repeated check of an existing brand *)
        RETURN;
      ELSIF (node.val8 = t.val8) AND (node.val16 = t.val16) THEN
        IF (node.type.origin # t.type.origin) THEN
          (* error, duplicate brand *)
          DuplicateError (t);
          DuplicateError (node);
        END;
        RETURN;
      END;
      node := node.next;
    END;
  END CheckDuplicate;

PROCEDURE DuplicateError (t: T) =
  VAR save := Scanner.offset;
  BEGIN
    IF NOT t.error THEN
      t.error := TRUE;
      Scanner.offset := t.origin;
      Error.Txt (ToText (t), "duplicate brand");
      Scanner.offset := save;
    END;
  END DuplicateError;

PROCEDURE Compile (t: T): INTEGER =
  VAR offset := -1;  len, n_bytes: INTEGER;
  BEGIN
    IF (t = NIL) THEN
      (* no brand *)
    ELSIF (t.val8 # NIL) THEN
      len := Target.Char.size * (M3String.Length (t.val8) + 1);
      n_bytes := (len - Target.Char.size) DIV Target.Int8.size;
      offset := Module.Allocate (Target.Integer.size + len,
                                 Target.Integer.align, TRUE, "brand");
      CG.Init_intt (offset, Target.Integer.size, n_bytes, TRUE);
      M3String.Init_chars (offset + Target.Integer.size, t.val8, TRUE);
    ELSIF (t.val16 # NIL) THEN
      len := Target.Int16.size * (M3WString.Length (t.val16) + 1);
      n_bytes := (len - Target.Int16.size) DIV Target.Int8.size;
      offset := Module.Allocate (Target.Integer.size + len,
                                 Target.Integer.align, TRUE, "brand");
      CG.Init_intt (offset, Target.Integer.size, n_bytes, TRUE);
      M3WString.Init_chars (offset + Target.Integer.size, t.val16, TRUE);
    END;
    RETURN offset;
  END Compile;

PROCEDURE GenFPrint (t: T;  VAR x: M3.FPInfo) =
  BEGIN
    IF (t = NIL) THEN
      (* no brand info *)
    ELSIF (t.val8 # NIL) THEN
      M3Buf.PutText (x.buf, "-BRAND8 ");
      M3Buf.PutInt  (x.buf, M3String.Length (t.val8));
      M3Buf.PutChar (x.buf, ' ');
      M3String.Put  (x.buf, t.val8);
    ELSIF (t.val16 # NIL) THEN
      M3Buf.PutText (x.buf, "-BRAND16 ");
      M3Buf.PutInt  (x.buf, M3WString.Length (t.val16));
      M3Buf.PutChar (x.buf, ' ');
      M3WString.PutLiteral (x.buf, t.val16);
    END;
  END GenFPrint;

PROCEDURE Equal (a, b: T): BOOLEAN =
  BEGIN
    IF    (a = NIL)       OR  (b = NIL)       THEN  RETURN (a = b);
    ELSIF (a.val8  # NIL) AND (b.val8 # NIL)  THEN  RETURN (a.val8 = b.val8);
    ELSIF (a.val16 # NIL) AND (b.val16 # NIL) THEN  RETURN (a.val16 = b.val16);
    ELSIF (a.val8  # NIL) AND (b.val16 # NIL) THEN  RETURN FALSE;
    ELSIF (a.val16 # NIL) AND (b.val8 # NIL)  THEN  RETURN FALSE;
    ELSE  RETURN Expr.IsEqual (a.expr, b.expr, NIL);
    END;
  END Equal;

PROCEDURE ToText (t: T): TEXT =
  VAR txt: TEXT := NIL;
  BEGIN
    IF    (t = NIL)       THEN txt := NIL;
    ELSIF (t.val8  # NIL) THEN txt := M3String.ToText (t.val8);
    ELSIF (t.val16 # NIL) THEN txt := M3WString.ToLiteral (t.val16);
    END;
    RETURN txt;
  END ToText;

BEGIN
END Brand.