unit d2tabx86;

interface
uses
  d2type,dt2x86;

  type

    pFixUp = ^tFixUp;
    tFixUp = Object
      Where : Word;
      Next : pFixUp;
      Constructor Init(W:Word;L:pFixUp);
    End;

    pTerm = ^Term;
    Term = Record
      Name:pString;     (* имя терма         *)
      Typ:rsvType;     (* тип терма         *)
      Loc:word;        (* число параметров  *)
      Par:word;         (* приоритет         *)
      Hidd:hidd_type;   (* область видимости *)
      OName:word;       (* внешнее имя       *)
      Dynamic:boolean;  (* тип вызова        *)
      FixUp:pFixUp;
      Next:pterm;
      Case Extrn : boolean Of
        True: (Size : Word; Body : PInlineBuf);
        False: (Offs : Word)
    end;

    tLocal = Object
      Itm:pTerm;
      Constructor Init;
      Destructor Done;Virtual;
      Function AddTerm(N:String;T:rsvType;P:word;H:hidd_type):pTerm;
      Function CheckTerm(N:String):pTerm;
      Procedure Clear;
    End;

    tHash = Object
      Hidd : Set Of byte;               (*список початых гроздей*)
      Table : Array[Byte] Of pTerm;     (*грозди с термами*)
      Constructor Init;
      Destructor Done;virtual;
      Function AddTerm(N:String;T:rsvType;P:word;H:hidd_type):pTerm;
      Function CheckTerm(N:String):pTerm;
      Procedure HiddAll;
      Procedure Clear;
      Function IdentCheck:Boolean;
      Function HashFunc(S:String):Byte;
      Procedure WriteHashInfo(Var F:TEXT);
    End;

    pType = ^tType;
    tType = Object(tString)
      Len : Word;
      Constructor Init(N:OpenString;L:Word);
    End;


    pconst = ^tconst;
    tconst = object
      name : pstring;
      body : pstring;
      typ1 : lexType;
      typ2 : rsvType;
      typ3 : word;
      next : pconst;
      constructor addconst(old:pconst;_n,_b:string;_t1:lexType;_t2:rsvType;_t3:word);
      procedure checkconst(var _n:string;var _t1:lexType;var _t2:rsvType;var _t3:word);
    end;


    Var
      Tab : tHash;
      Typ : tType;
      Loc : tLocal;
      con : pconst;

implementation

    Constructor tHash.Init;
    Var              (*нигде нихрена нету*)
      I:Byte;
    Begin
      Hidd:=[];
      For I:=Low(Byte) To High(Byte) Do Table[I]:=Nil;
    End;

    Destructor tHash.Done;
    Var
      I:Byte;
    Begin
      For I:=Low(Byte) To High(Byte) Do Hidd:=Hidd+[I];
      Clear;
    End;


    Function tHash.HashFunc;
    Begin
      HashFunc:=(Ord(S[0])) Xor Ord(S[Ord(S[0])]) Shl Byte(Odd(Ord(S[0])));
    End;

    Function tHash.addTerm;
    Var
      I:Byte;
      Tmp:pTerm;
    begin
      New(Tmp);
      Tmp^.Name:=New(pString,Init(N));
      Tmp^.Typ:=T;
      Tmp^.Par:=P;
      Tmp^.FixUp:=Nil;
      Tmp^.dynamic:=dnmFLG;
      If H=_Extrn Then Begin
        Tmp^.Hidd:=_HIDDMOD;
        Tmp^.Extrn:=True;
      End Else Begin
        Tmp^.Hidd:=H;
        Tmp^.Extrn:=False
      End;
      Tmp^.Oname:=Rescnt;
      Tmp^.Offs:=0;
      If T=_SUB Then Inc(ResCnt,2) Else Inc(ResCnt);
      I:=HashFunc(N);
      Tmp^.Next:=Table[I];
      Table[I]:=Tmp;
      addTerm:=Tmp;
      Hidd:=Hidd+[I];
    end;

    Function tHash.CheckTerm;
    Var
      I:Byte;
      Pos:pTerm;

      Function Cond:Boolean;
      Begin
        If (Pos^.Name^.Getstr=N) And ((HiddType = Pos^.Hidd) Or (Pos^.Hidd = _HIDDMOD)) Then
          Cond:=True
        Else
          Cond:=False;
      End;

    Begin
      Pos:=Table[HashFunc(N)];
      While (Pos<>Nil) And ( Not Cond )Do Pos:=Pos^.Next;
      CheckTerm:=Pos;
    end;

    Function tHash.IdentCheck;
    Var
      I:Byte;
      Pos:pterm;
    Begin
      For I:=Low(Byte) To High(Byte) Do Begin
        Pos:=Table[I];
        While Pos<>Nil Do Begin
          If (not Pos^.Extrn) And (Pos^.Offs=0) Then
            errorMsg(Input,'unknown identifier '+Pos^.Name^.GetStr);
          Pos:=Pos^.Next;
        End;
      End;
    End;


    procedure tHash.HiddAll;
    Var
      I:Byte;
      Pos:pTerm;
    begin
      For I:=Low(Byte) To High(Byte) Do
        If I In Hidd Then Begin
          Pos:=Table[I];
          While Pos<>Nil Do Begin
            If Pos^.Hidd = _HIDDLIB Then Pos^.Hidd:=_HIDDALL;
            Pos:=Pos^.Next;
          End;
        End;
      Hidd:=[];
    End;

    Procedure tHash.WriteHashInfo;
    Var
      I:Byte;
      M:LongInt;
      T:Array[Byte]Of Word;

      Function CalcItems(P:pTerm):Word;
      Var
        C:Word;
      Begin
        C:=0;
        While P<>Nil Do Begin
          Inc(C);
          P:=P^.Next;
        End;
        CalcItems:=C;
      End;

    Begin
      M:=0;
      For I:=Low(Byte) To High(Byte) Do Begin
        T[I]:=CalcItems(Table[I]);
        M:=M+T[I];
      End;
      For I:=Low(Byte) To High(Byte) Do Begin
        Write(F,I:3,'-',100.0*T[I]/M:4:2,'% ');
        If Not Boolean(I Mod 6) Then WriteLn(F);
      End;
    End;




    procedure tHash.Clear;
    Var                  (*чистим всю хэш-таблицу*)
      I:Byte;
      Pos:pterm;
      Del:pterm;
    begin
      For I:=Low(Byte) To High(Byte) Do
        If I In Hidd Then Begin
          Pos:=Table[I];
          While Pos<>Nil Do Begin
            Del:=Pos;
            Pos:=Pos^.Next;
            Dispose(Del^.Name,Done);
            Dispose(Del);
          End;
          Table[I]:=Nil;
        End;
      Hidd:=[];
    End;


    constructor tconst.addconst;
    begin
      name:=new(pstring,init(_n));
      body:=new(pstring,init(_b));
      typ1:=_t1;
      typ2:=_t2;
      typ3:=_t3;
      next:=old;
    end;

    procedure tconst.checkconst;
    var
      pos:pconst;
    begin
      pos:=@self;
      while (pos<>nil) and (pos^.name^.getstr<>_n)do pos:=pos^.next;
      if pos<>nil then
        begin
          _n:=pos^.body^.getstr;
          _t1:=pos^.typ1;
          _t2:=pos^.typ2;
          _t3:=pos^.typ3;
        end;
    end;

   Constructor tLocal.Init;
   Begin
     Itm:=Nil;
   End;

   Destructor tLocal.Done;
   Begin
     Clear
   End;

   Function tLocal.addTerm;
    Var
      Tmp:pTerm;
    begin
      New(Tmp);
      Tmp^.Name:=New(pString,Init(N));
      Tmp^.Typ:=T;
      Tmp^.Par:=P;
      Tmp^.Hidd:=H;
      Tmp^.Extrn:=False;
      Tmp^.Oname:=0;
      Tmp^.Next:=Itm;
      Itm:=Tmp;
      addTerm:=Tmp;
    end;

    Function tLocal.CheckTerm;
    Var
      Pos:pTerm;

    Begin
      Pos:=Itm;
      While (Pos<>Nil) And (Pos^.Name^.Getstr<>N) Do Pos:=Pos^.Next;
      CheckTerm:=Pos;
    end;

    procedure tLocal.Clear;
    Var
      Pos:pterm;
      Del:pterm;
    begin
      Pos:=Itm;
      While Pos<>Nil Do Begin
        Del:=Pos;
        Pos:=Pos^.Next;
        Dispose(Del^.Name,Done);
        Dispose(Del);
      End;
      Itm:=Nil;
    End;


    Constructor tType.Init;
    Begin
      Inherited Init(N);
      Len:=L
    End;

    Constructor tFixUp.Init;
    Begin
      Where:=W;
      Next:=L
    End;


begin
  Tab.Init;
  Loc.Init;
  con:=new(pconst,addconst(nil,'compiler','D2 v.0.1.5',_QUOTE,_VAR,0));
end.