unit d2type;


interface

const
        _RL:char='{';
        _RR:char='}';

Type


  SymType = ( Finish, Alpha, Blank, Digit, Spec, Quote, Cmt, Delim, Unknown );
  tMap = Array [Char] Of SymType;

  PString = ^TString;
  TFunc = Procedure;

  tstring = object
    str:^string;
    constructor init(istr:OpenString);
    destructor done;virtual;
    function getstr:string;
  end;

        pSt = ^tSt;
        tSt = Record
          Name : pString;
          Ch : Char;
          Line,Column:Word;
          Stream : boolean;
          T : TEXT;
          Next : pSt
        End;


  PInlineBuf = ^TInlineBuf;
  TInlineBuf = Array [0..Pred(High(Word))] Of Byte;

  hidd_type = ( _HIDDALL, _HIDDLIB, _HIDDMOD, _EXTRN );

  LexType = (
        _UNKNOWN       ,
   (**) _DELIMITER     ,       (* разделитель                  *)
   (**) _VARIABLE      ,       (* переменная                   *)
   (**) _NUMBER        ,       (* число                        *)
   (**) _COMMAND       ,       (* команда                      *)
        _STRING        ,       (* строка                       *)
   (**) _QUOTE         ,       (* кавычки                      *)
        _WHITE         ,       (* пробел или символ табуляции  *)
   (**) _COMMENT       ,
        _SPECIAL       ,
        _FINISHED              (* конец программы              *)
   );

   RsvType = (
    _nil,
    _asm,
    _case,_const,_continue,_cycle,
    _do,
    _else,_elsif,_elsifn,_end,_exit,
    _fi,_for,
    _if,_ifn,_in,_inline,
    _leave,_library,_loop,
    _module,
    _new,_next,
    _of,
    _recur,_repeat,_return,
    _sub,
    _then,_type,
    _until,_use,
    _var,_vect,
    _wend,_while,
    _local

   );
   JumpType = ( __Jmp, __Jz, __Jl, __Jnz, __Jg, __Jge, __Jle);

    PNames = ^TNames;
    TNames = Array [RsvType] Of String[8];

    pType = ^tType;
    tType = Object(tString)
      Len : Word;
      Constructor Init(iStr:OpenString;iLen:Word);
      Destructor Done;Virtual;
    End;


Const
  LenShortJmp = $7F;

  NamesLowerCase : TNames =
  ( '',
    'asm',
    'case','const','continue','cycle',
    'do',
    'else','elsif','elsifn','end','exit',
    'fi','for',
    'if','ifn','in','inline',
    'leave','library','loop',
    'module',
    'new','next',
    'of',
    'recur','repeat','ret',
    'sub',
    'then','type',
    'until','use',
    'var','vect',
    'wend','while',
    ''
  );

  NamesUpperCase : TNames =
  ( '',
    'ASM',
    'CASE','CONST','CONTINUE','CYCLE',
    'DO',
    'ELSE','ELSIF','ELSIFN','END','EXIT',
    'FI','FOR',
    'IF','IFN','IN','INLINE',
    'LEAVE','LIBRARY','LOOP',
    'MODULE',
    'NEW','NEXT',
    'OF',
    'RECUR','REPEAT','RET',
    'SUB',
    'THEN','TYPE',
    'UNTIL','USE',
    'VAR','VECT',
    'WEND','WHILE',
    ''
  );

type
    pr_type = (_MOD,_LIB);

var
     rescnt : word;

     CodeSize,DataSize : Word;

     Target:string;

     CurSub : Pointer;

     Map:tMap;

     proctype:pr_type;
     hiddtype:hidd_type;

     {global switches}
     memSR : word;     {R}   {return stack size         }
     memSA : word;     {A}   {arifmetic stack size      }
     memSI : word;     {S}   {max inline size           }

     incld : boolean;  {I}   {inline compiling mode     }
     dbgFLG: boolean;  {D}
     optFLG: boolean;  {O}   {optimization              }
     jmpFLG: boolean;  {J}
     dnmFLG: boolean;  {V}
     ipx386: boolean;  {3}
     uprFLG: boolean;  {U}   { case of reserved words   }
     cseFLG: boolean;  {C}   { case sensitivites        }
     ModuleDir : string;     { dir for modules          }
     LibraryDir : string;    { dir for librarys         }

Const
    DefExt : Array[pr_type] Of String[3] = ('COM','LIB');

    Function Names:PNames;
    Function hash_func (Str:OpenString ) : byte;
    Procedure ErrorMsg(Input:pSt;Msg:OpenString);
    Procedure WarningMsg(Input:pSt;Msg:OpenString);
    Function InvJump(J:JumpType):JumpType;



implementation

   constructor tstring.init;
   begin
     getmem(str,length(istr)+1);
     str^:=istr;
   end;

   destructor tstring.done;
   begin
     freemem(str,succ(ord(str^[0])));
   end;

   function tstring.getstr;
   begin
     getstr:=str^
   end;

   constructor ttype.init;
   begin
     inherited init(istr);
     len:=ilen;
   end;

   destructor ttype.done;
   begin
     inherited done
   end;

   Function Names;
   Begin
     If uprFLG Then
       Names:=@NamesUpperCase
     Else
       Names:=@NamesLowerCase
   End;

   (* хэш-функция для зарезервированных слов д2
      используется также и для идентификаторов *)
   {возвращает уникальное значение для каждого зарезервированного слова}
   function hash_func ( str : string ) : byte;
   begin
     hash_func := ( 7* ord(str[1])+13*ord(str[ ord(str[0]) ])+3*ord(str[0]) ) mod 255
   end;

  (* выдать сообщение об ошибке *)
  procedure errorMsg;
  begin
    writeln;
    write('**ERROR**');
    If Input<>Nil Then With Input^ Do
      WriteLn(' (',Name^.GetStr,') ',Msg,' in line ',line,' column ',column,'.')
    Else
      WriteLn(Msg);
    INLINE($33/$C0/$CD/$16/$32/$E4);
    Halt;
   end;

   procedure warningMsg;
  begin
    writeln;
    write('*WARNING*');
    If Input<>Nil Then With Input^ Do
      WriteLn(' (',Name^.GetStr,') ',Msg,' in line ',line,' column ',column,'.')
    Else
      WriteLn(Msg);
   end;


   Function InvJump;
   Begin
     Case J Of
       __Jmp:;
       __Jz : J:=__Jnz;
       __Jl : J:=__Jge;
       __Jnz: J:=__Jz;
       __Jg : J:=__Jle;
       __Jge: J:=__Jl;
       __Jle: J:=__Jg;
     End;
     InvJump:=J
   End;



Var
                I : Char;

begin
                rescnt:=0;
                memSR:=1024;
                memSA:=2048;
                memSI:=10;
                ipx386:=true;
                incld:=false;
                dbgFLG:=false;
                optFLG:=true;
                jmpFLG:=false;
                dnmFLG:=true;
                uprFLG:=true;
                cseFLG:=false;
                ModuleDir:='';
                LibraryDir:='';
                {--------------------}
                For I:=#0 To #255 Do Map[I]:=Unknown;
                For I:=#0 To #32 Do Map[I]:=Blank;
                Map[#127]:=Blank;
                Map[#26]:=Finish;
                For I:='A' To 'Z' Do Map[I]:=Alpha;
                For I:='a' To 'z' Do Map[I]:=Alpha;
                Map['_']:=Alpha;
                For I:=#128 To #175 Do Map[I]:=Alpha;
                For I:=#224 To #241 Do Map[I]:=Alpha;
                For I:='0' To '9' Do Map[I]:=Digit;
                Map['$']:=Delim;
                Map[';']:=Spec;
                Map[',']:=Spec;
                Map['(']:=Spec;
                Map[')']:=Spec;
                Map['[']:=Spec;
                Map[']']:=Spec;
                Map['''']:=Quote;
                Map['{']:=Cmt;
                Map['}']:=Cmt;
                Map['`']:=Delim;
                Map['~']:=Delim;
                Map['!']:=Delim;
                Map['@']:=Delim;
                Map['#']:=Delim;
                Map['%']:=Delim;
                Map['^']:=Delim;
                Map['&']:=Delim;
                Map['*']:=Delim;
                Map['-']:=Delim;
                Map['+']:=Delim;
                Map['=']:=Delim;
                Map[':']:=Delim;
                Map['"']:=Delim;
                Map['<']:=Delim;
                Map['>']:=Delim;
                Map['.']:=Delim;
                Map['/']:=Delim;
                Map['|']:=Delim;
                Map['\']:=Delim;
                Map['?']:=Delim;

                CodeSize:=0;
                DataSize:=0;
end.