Unit Symbolize;
{* S Compiler, ver 1.00.
   Copyright (C) 1994, Henri LESOURD.

   This software is free software; you can redistribute it and/or
   modify it under the terms of the GNU Library General Public License as
   published by the Free Software Foundation; either version 2 of the
   License, or (at your option) any later version.

   This compiler is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Library General Public License for more details.

   You should have received a copy of the GNU Library General Public
   License along with the GNU C Library; see the file COPYING.LIB.  If not,
   write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
   Boston, MA 02111-1307, USA.  *}

Interface

{ Table des chaines }
Function StoreString(Var S : String) : Word;
Procedure WriteString(A : Word);
Procedure FWriteString(Var F : Text; A : Word);
Function GetStringAddr(I : Word) : Pointer;

{ Table des symboles }
Const
    { Les natures }
      KeyWord=0;Operator=$4000;Symbol=$8000;Constant=$C000;

{ *********
  Registres
  ********* }
Const
     AX=0;DX=1;CX=2;BX=3;SI=4;DI=5;rES=6;BP=7;SP=8;rCS=9;rDS=10;rSS=11;
     AL=0;DL=1;CL=2;BL=3;DH=4;BH=5;      CH=7;AH=8;

     RegHigh : Array[AX..BX] Of Byte=(AH,DH,CH,BH);

     IsSegReg : Array[AX..rSS] Of Boolean=
       (
          False,False,False,False,
          False,False,
          True,
          False,False,
          True,True,True
       )
     ;
     IsAddrReg : Array[AX..rSS] Of Boolean=
       (
          False,False,False,True,
          True,True,
          False,
          False,False,
          False,False,False
       )
     ;
     IsDataReg : Array[AX..rSS] Of Boolean=
       (
          True,True,True,True,
          False,False,
          False,
          False,False,
          False,False,False
       )
     ;
{ ***************************** }
{ * Type pointeur sur symbole * }
{ ***************************** }
Type
    SymbPtr=^Symb;

  { ************* }
  { * Compilify * }
  { ************* }
    Class=(
             CS,DS,SS,ES,Extern,Export,NullExport,
             Register,Immediate,
             Reg32,RegMem32,MemReg32,Mem32,
             CType,Null
          )
          ;
    Mode=(
            IndOfs,IndReg,IndRegOfs
         )
         ;
    TypedAddressPtr=^TypedAddress;
    TypedAddress=Record
                   C : Class;
                   M : Mode;
                   Value : LongInt;
                   SType : SymbPtr;
                 End;

  { ************* }
  { * Compilify * }
  { ************* }

  { **************** }
  { * Type symbole * }
  { **************** }
    Symb=Record
           Nature,Name : Word;
           Addr : TypedAddress;
           Suiv : SymbPtr;
         End;

  { ******************* }
  { * Type MaskedSymb * }
  { ******************* }
    MaskedSymbPtr=^MaskedSymb;
    MaskedSymb=Record
                 Old : SymbPtr;
                 Addr : TypedAddress;
                 Suiv : MaskedSymbPtr;
               End;

Var
   StrMemPtr : Word;

Procedure PutSymb(S : SymbPtr; Str : String);
Function NewSymb(Var S : String) : SymbPtr;
Function FindSymb(Var S : String) : SymbPtr;
Procedure PrintSymbName(S : SymbPtr);
Procedure VisuHash;
Procedure ResetHash;

Implementation

Uses
    Crt,Errorify;

{ Table des chaines }

Const
     SizStrMem=15000;
Var
   StrMem : Array[1..SizStrMem] of Char;

Function StoreString(Var S : String) : Word;
Var
   I : Word;
Begin
  If (StrMemPtr+Ord(S[0])+1>SizStrMem+1) Then Error('StrMem Full');
  StrMem[StrMemPtr]:=S[0];
  For I:=1 To Ord(S[0]) do
                          StrMem[StrMemPtr+I]:=S[I];
  StoreString:=StrMemPtr;
  StrMemPtr:=StrMemPtr+Ord(S[0])+1;
End;

Procedure WriteString(A : Word);
Var
   StrPtr : ^String;
Begin
  StrPtr:=@StrMem[A];
  Write(StrPtr^);
End;

Procedure FWriteString(Var F : Text; A : Word);
Var
   StrPtr : ^String;
Begin
  StrPtr:=@StrMem[A];
  Write(F,StrPtr^);
End;

Function GetStringAddr(I : Word) : Pointer;
Begin
  GetStringAddr:=@StrMem[I];
End;

{ Table des symboles }

Var
   HashTable : Array[0..$FF] of SymbPtr;

Function HCode(Var S : String) : Byte;
Var
   I : Word;
   B : Word;
Begin
  B:=0;
  For I:=1 To Ord(S[0]) do
  Begin
    B:=(B+Ord(S[I])) mod $100;
  End;
  HCode:=Lo(B);
End;

Procedure PutSymb(S : SymbPtr; Str : String);
Var
   H : Byte;
Begin
  H:=HCode(Str);
  S^.Name:=StoreString(Str);
  S^.Suiv:=HashTable[H];
  HashTable[H]:=S;
End;

Function NewSymb(Var S : String) : SymbPtr;
Var
   H : Byte;
   Result : SymbPtr;
Begin
  H:=HCode(S);
  New(Result);
  If Result=Nil Then Error('NewSymb : Out of memory');
  Result^.Nature:=Symbol Or $3FFF;
  Result^.Name:=StoreString(S);
  Result^.Addr.C:=Null;
  Result^.Addr.Value:=LongInt($FFFFFFFF);
  Result^.Addr.SType:=Nil;
  Result^.Suiv:=HashTable[H];
  HashTable[H]:=Result;
  NewSymb:=Result;
End;

Function FindSymb(Var S : String) : SymbPtr;
Var
   H : Byte;
   Cour : SymbPtr;
   StrPtr : ^String;
Begin
  H:=HCode(S);
  FindSymb:=Nil;
  Cour:=HashTable[H];
  While Cour<>Nil do
  Begin
    StrPtr:=@StrMem[Cour^.Name];
    If S=StrPtr^ Then
      Begin
        FindSymb:=Cour;Cour:=Nil;
      End
    Else
      Cour:=Cour^.Suiv;
  End;
End;

Procedure PrintSymbName(S : SymbPtr);
Var
   StrPtr : ^String;
Begin
  StrPtr:=@StrMem[S^.Name];
  Write(StrPtr^);
End;

Procedure VisuHash;
Var
   I : Byte;
   Cour,Cour0 : SymbPtr;
   NbSymbs : Word;
Begin
  NbSymbs:=0;
  For I:=0 To $FF do
  Begin
    Cour:=HashTable[I];
    If Cour<>Nil Then Write(I,': ');
    Cour0:=Cour;
    While Cour<>Nil do
    Begin
      Write('<');PrintSymbName(Cour);Write('> ');
      Inc(NbSymbs);
      Cour:=Cour^.Suiv;
    End;
    If Cour0<>Nil Then WriteCarriage;
  End;
  WriteCarriage;
  Write('NbSymbs=',NbSymbs,'; StrMemPtr=',StrMemPtr);
  WriteCarriage;
End;

Procedure ResetHash;
Var
   I : Byte;
Begin
  StrMemPtr:=1;
  For I:=0 to $FF do HashTable[I]:=Nil;
End;

Begin
  ResetHash;
End.
