Const
  LingvoNum : LongInt = 0;
  A : Array[1..4] Of String[20] = ('1.Идентификатор','2. Ключевые слова',
      '3. Константа','4. Разделители');
  A3 : Array[1..7] Of String[20] =('3.1 Integer','3.2 Real','3.3 Символ','3.4 Строка','3.5 Логическая',
                                   '3.6 Массив','3.7 Byte');
  A3_ : Array[1..7] of word=(2,4,1,256,1,0,1);
{--------------------------------------------}
  NKW = 43;
  KeyWords : Array[1..NKW] Of Record
                 S    : String[10];
                 Code : Word;
       End=((S:'BEGIN'),(S:'END'),(S:'VAR'),(S:'TYPE'),(S:'NOT'),(S:'OR'),
             (S:'AND'),(S:'XOR'),(S:'ARRAY'),(S:'IF'),(S:'THEN'),(S:'ELSE'),
             (S:'CASE'),(S:'OF'),(S:'FOR'),(S:'TO'),(S:'DO'),(S:'CONST'),(S:'DOWNTO'),
             (S:'DIV'),(S:'MOD'),(S:'FUNCTION'),(S:'PROCEDURE'),(S:'GOTO'),(S:'IN'),
             (S:'LABEL'),(S:'NIL'),(S:'SET'),(S:'REPEAT'),(S:'UNTIL'),(S:'RECORD'),
             (S:'STRING'),(S:'USES'),(S:'WHILE'),(S:'WITH'),(S:'BYTE'),(S:'WORD'),
             (S:'REAL'),(S:'INTEGER'),(S:'BOOLEAN'),(S:'CHAR'),(S:'NEG'),(S:'INLINE'));
{--------------------------------------------}  
  NSS  = 15;
  SSym : Array[1..NSS] Of Char = ('(',')', '.' , ',' , ';' ,':','/','=','+','-','[',']','*','<','>');
{--------------------------------------------}
Type
{---- Тип для индексом массивов ------}
  IndexP = ^IndexT;
  IndexT = Record
             Size        : Word; {размер одного элемента Size=Next^.(Last-First)*Size}
             First, Last : Integer; {начальныйй и конечный индекс массива}
             TTy         : Byte; {1-int,2-real,3-char,4-string,5-boolean;6-array;7-byte;8-proc;9-funct}
             Next, Prev  : IndexP;             
           End;
{-------------------------------------}
  BlockP = ^BlockT;
  ListP = ^List;
  List  = Record
        S    : String;
        TTy  : Word; {тип}
        Code : Integer; {адрес}
        Size : Word; {размер}
        IndexL : IndexP;
        Next : ListP;
        proc : blockp;
  End; 
{--------------------------------------------}
  LingvoP = ^Lingvo;
  Lingvo  = Record
              LType : Byte;
              LCode : Integer;
              LPnt  : LongInt;
              Next  : LingvoP;
            End;
{----------------------------}
   BlockT = Record
              BeginN,EndN,BlN : LongInt;
              LevelNum        : Integer;
              ProcName        : String[64];
              NextLevel,Next  : BlockP;
              addr            : word;
              Prev            : BlockP;
              IdentL          : ListP;
            End;
{--------------------------------------------}
  calladdrP = ^calladdrt;
  calladdrt = record
    fromcall : word;
    who      : BlockP;
    next     : calladdrp;
  end;

const
  myrecall : calladdrp=nil;

procedure addcall(addr:word;m:blockp);
var n : calladdrp;
begin
  n:=myrecall;
  new(myrecall);
  myrecall^.next:=n;
  myrecall^.who:=m;
  myrecall^.fromcall:=addr;  
end;
{----------------------------}
Const
  SSet : Set Of Char = [':','/','+','=','(',')','-',',',';','[',']','*','<','>','.'];
  ISet : Set Of Char = ['A'..'Z','a'..'z','_'];
  CSet : Set Of Char = ['0','1'..'9',#$27,'#','$'];
{----------------------------}
Var
  IsB, CsB : ListP;
  Main, Cu : BlockP;
  Lin      : LingvoP;
{----------------------------------------}
Function ListFindP(I:LongInt;L:ListP):ListP;
Var
  M : ListP;
  Z : LongInt;
Begin
  M:=L;Z:=1;
  While (M<>Nil) And (Z<I) Do Begin
    Inc(Z);
    M:=M^.Next;
  End;
  If Z=I Then ListFindP:=M
         Else ListFindP:=nil;
End;
{===========================================}
Procedure AddLingvo(LT:Byte;LC:Integer;LP:LongInt);
Var
  LinP : LingvoP;
  Test : ListP;
Begin
  Inc(LingvoNum);
  IF Lin=Nil Then Begin
    New(Lin); 
    Lin^.Next:=Nil;
    Lin^.LType:=LT;
    Lin^.LCode:=LC;
    Lin^.LPnt:=LP;
    Exit;
  End;
  LinP:=Lin;
  While LinP^.Next<>Nil Do Begin
   LinP:=LinP^.Next;
  End;
  New(LinP^.Next);
  LinP:=LinP^.Next;
  LinP^.LType:=LT;
  LinP^.LCode:=LC;
  LinP^.LPnt:=LP;
  LinP^.Next:=Nil;
{-------- типы и размеры констант --------------------}
  If LT=3 Then begin 
    test:=listfindp(lp,csb);
    test^.tty:=lc;
    test^.size:=a3_[lc];    
  end;
End;
{--------------------------------------------}
Function GetNumber(S:String;Var L:ListP):Word;
Var
  N : Word;
  M : ListP;
Begin
  If L=Nil Then Begin
    New(L);
    L^.S:=S;
    L^.Next:=Nil;
    GetNumber:=1;
    Exit;
  End;
  N:=1;M:=L;
  While (M^.S<>S) And (M^.Next<>Nil) Do Begin M:=M^.Next;Inc(N);End;
  If M^.S=S Then Begin 
    GetNumber:=N; Exit;
  End;
  New(M^.Next);
  M:=M^.Next;
  M^.S:=S;
  M^.Next:=Nil;
  GetNumber:=N+1;
End;
{--------------------------------------------}
Function FindNumber(S:String;Var L:ListP):Word;
Var
  N : Word;
  M : ListP;
Begin
  N:=1;
  M:=L;
  While (M^.S<>S) And (M<>Nil) Do Begin M:=M^.Next;Inc(N);End;
  If M^.S=S Then Begin 
    FindNumber:=N; Exit;
  End;
  FindNumber:=0;
End;
{----------------------------------------}
Procedure ListDone(L:ListP);
Var
  M : ListP;
Begin
  While L<>Nil Do Begin
    M:=L^.Next;
    Dispose(L);
    L:=M;
  End;
End;

{----------------------------------------}
Function ListFind(I:LongInt;L:ListP):String;
Var
  M : ListP;
  Z : LongInt;
Begin
  M:=L;Z:=1;
  While (M<>Nil) And (Z<I) Do Begin
    Inc(Z);
    M:=M^.Next;
  End;
  If Z=I Then ListFind:=M^.S
         Else ListFind:='';
End;
{----------------------------------------}
Procedure LinDone(L:LingvoP);
Var
  M : LingvoP;
Begin
  While L<>Nil Do Begin
    M:=L^.Next;
    Dispose(L);
    L:=M;
  End;
End;