unit da2x86;

interface



uses d2type,d2tabx86,d2comp;



Type

   pfpa = ^tfpa;
   tfpa = object    (* стек скобок *)
     w:word;        (* уровень вложенности *)
     next:pointer;
   end;

   psem = ^tsem;
   tsem = object(tfpa)  (* семантический стек *)
     t:lexType;
     a:boolean;
     n:pstring;         (* терм *)
   end;

   pstack = ^tstack;
   tstack = object
     sem:psem;
     fpa:pfpa;
     fpa_,sem_:word;
     constructor init;
     destructor done;virtual;
     procedure parse;
   end;

   var
     parser:pstack;

   Procedure ExecParse;
{   Function ExecCond:JumpType;}
   {---}
   Procedure FixStrs;
   Procedure AddString(_Fix:Word;_Str:String);


implementation

uses
  dt2x86;

Const

  _VNPRYOR = -1;

constructor tstack.init;
begin
  fpa_:=0;
  sem_:=0;
  fpa:=nil;
  sem:=nil;
end;

destructor tstack.done;
begin

end;

Type
  pFixStr = ^FixStr;
  FixStr = Record
    Fix : Word;
    Str : pString;
    Next : pFixStr;
  End;

Var
  FS:pFixStr;

Procedure AddString(_Fix:Word;_Str:String);
Var
  St:pFixStr;
Begin
  New(St);
  St^.Fix:=_Fix;
  New(St^.Str,Init(_Str));
  St^.Next:=FS;
  FS:=St;
End;

Procedure FixStrs;
Var
  Del,Pos : pFixStr;
Begin
  Pos:=FS;
  While Pos<>Nil Do Begin
    Del:=Pos;
    Pos:=Del^.Next;
    c^.iWord(Del^.Fix-2,c^.cIP);
    c^.cAscii2z(Del^.Str^.GetStr);
    Dispose(Del^.Str,Done);
    Dispose(Del);
  End;
  FS:=Nil;
End;

procedure tstack.parse;

          function Emptyfpa:boolean;
          begin
            Emptyfpa:=fpa_=0
          end;

          function getfpa:word;
          begin
            if Emptyfpa then
              getfpa:=0
            else
              getfpa:=fpa^.w
          end;

          function Emptysem:boolean;
          begin
            Emptysem:=not (sem_>getfpa)
          end;

          function Get_String:string;
          begin
            Get_string:=sem^.n^.getstr
          end;

          function popsem(var typ:lexType;var ad:boolean):string;
          var
            tmp:psem;
          begin
            typ:=sem^.t;
            ad:=sem^.a;
            popsem:=sem^.n^.getstr;
            dispose(sem^.n,done);
            tmp:=sem;
            sem:=sem^.next;
            dispose(tmp);
            dec(sem_);
          end;

          procedure pushsem(str:string;typ:lexType;ad:boolean);
          var
            tmp:psem;
          begin
            inc(sem_);
            new(tmp);
            tmp^.n:=new(pstring,init(str));
            tmp^.t:=typ;
            tmp^.a:=ad;
            tmp^.next:=sem;
            sem:=tmp;
          end;

          function popfpa:word;
          var
            tmp:pfpa;
          begin
            popfpa:=fpa^.w;
            tmp:=fpa;
            fpa:=fpa^.next;
            dispose(tmp);
            dec(fpa_);
          end;

          procedure pushfpa(w:word);
          var
            tmp:pfpa;
          begin
            inc(fpa_);
            new(tmp);
            tmp^.w:=w;
            tmp^.next:=fpa;
            fpa:=tmp;
          end;

          function pryor(st:string):integer;
          var
            v:pterm;
          begin
            v:=Tab.CheckTerm(st);
            if (v=nil) then
                pryor:=_VNPRYOR
            else
              if v^.typ = _SUB then
                pryor:=v^.par
              else
                pryor:=_VNPRYOR;
          end;


          function lt_pryor(op,ch:string):boolean;
          begin
            lt_pryor:=pryor(op)<=pryor(ch)
          end;


          Procedure PushAX(AX:Word);
          Begin
            c^._push_ax;
            If AX=0 Then
              c^.cWord($C033)
            Else Begin
              c^.cByte($B8);c^.cWord(AX);       {mov ax,value}
            End;
          End;

          Procedure PushAXOffs(AX:Word);
          Begin
            c^._push_ax;
            c^.cByte($A1);c^.cWord(AX);       {mov ax,value}
          End;

          Procedure EnterString(s:String);
          Begin
            PushAx(High(Word));
            AddString(c^.cIP,s);
          End;

          Procedure EnterGlobal(A:Boolean;V:PTerm);
          Var
            w:Word;
          Begin

{            If V^.Name^.GetStr ='=' Then Begin
              c^.cByte($5b);
              c^.cByte($89);
              c^.cByte($07);
              c^.cCode($58);;
              Exit;
            End;}


            If A Then Begin                     {addres?}
              PushAX(v^.offs);
            End Else
              If v^.typ = _SUB Then  Begin      {subroutine?}
                Case v^.Extrn Of                {external?}
                  True:                         {inline paste}
                    If v^.Size<=memSI Then Begin
                      For w:=0 To Pred(v^.Size) Do c^.cByte(v^.Body^[w]);
                    End Else Begin
                      c^.cByte($E8);c^.cWord(0);
                      c^.AddFixUp(v,v^.Size);
                    End;
                  False:                        {call v}
                    Begin
                      If (not dnmFLG) and (pTerm(CurSub)^.Name^.GetStr=v^.Name^.GetStr) Then
                        ErrorMsg(Input,'invalid call (use $V+)');
                      c^.cByte($E8);
                      If v^.Offs<>0 Then
                        c^.cWord(v^.offs-c^.cIP-2)
                      Else Begin
                        c^.cWord(0);
                        v^.FixUp:=New(pFixUp,Init(c^.cIP,v^.FixUp));
                      End;
                    End;
                  End
              End Else Begin                    {variable}
                PushAXOffs(v^.offs);
              End;
          End;

          Procedure EnterLocal(A:Boolean;L:PTerm);

            Procedure EnterDynamicLocal;
            Begin
              If A then begin
                c^._push_ax;
                c^.cWord($C58B);                  {mov ax,bp}
                If L^.par>0 Then Begin
                  c^.cByte($05);c^.cWord(L^.par); {add ax, parNo}
                End;
              End Else Begin
                c^._push_ax;
                If L^.Par>$7F Then Begin
                  c^.cWord($868B);c^.cWord(L^.Par); {mov ax,[bp+parNo]}
                End Else Begin
                  c^.cWord($468B);c^.cByte(L^.Par); {mov ax,[bp+parNo]}
                End;
              End;
            End;

            Procedure EnterStaticLocal;
            Begin
              If A then begin
                PushAX(L^.par);                 {mov ax,par}
              End Else Begin
                PushAXOffs(L^.par);                {mov ax,[par]}
              End;
            End;


          Begin
            If dnmFLG Then
              EnterDynamicLocal
            Else
              EnterStaticLocal
          End;

          Procedure EnterNumber(s:String);
          Var
            w:Word;
            e:Integer;
          Begin
            val(s,w,e);
          {  c^._push_ax;
            c^.cByte($B8);c^.cWord(W);          {mov ax,W}
            PushAX(W);
            {---}
{            PushT(_wrd);}
          End;

          procedure Enter(s1:string;typ:lexType;ad:boolean);
          var
            v:pterm;
          begin
            case typ of
              _QUOTE:
                 begin
                   if ad then errorMsg(Input,'illegal operation');
                   EnterString(s1);
                 end;
              _VARIABLE:
                 begin
                   v:=Loc.CheckTerm(s1); {local parameter?}
                   If v=nil Then Begin   {no...}
                     v:=Tab.CheckTerm(s1);
                     if v=nil then Begin
                       v:=Tab.AddTerm(s1,_SUB,1,hiddtype);
                       warningMsg(Input,'undefined identifier '+s1);
                       c^.cByte($E8);
                       v^.FixUp:=New(pFixUp,Init(c^.cIP,v^.FixUp));
                       c^.cWord(0);
                     End Else
                       EnterGlobal(ad,V);
                   End Else Begin {local}
                     EnterLocal(ad,V);
                   End;
                end;
              _NUMBER:
                begin
                  if ad then errorMsg(Input,'illegal operation');
                  EnterNumber(s1);
                end;
              else
                errorMsg(Input,'error in expression')
            End;
          end;

var
  os:string;
  typ:lexType;
  a,ad:boolean;


                procedure flushsem;
                begin
                  while not emptysem do Begin
                    os:=popsem(typ,ad);
                    Enter(os,typ,ad);
                  end;
                end;





begin
  a:=false;
  Repeat
    token;
    con^.checkconst(_token,_token_type,_tok,_number_tok);
    if a and (_token[1] in ['@','(',')',';',',']) then errorMsg(Input,'operand expected');
    (* если очередная лексема не оператор, то поехали... *)
    if _token_type <> _COMMAND then
    (**)
    if _token='@' then a:=true Else
    (* если открвающая скобка, то поместим ее в стек*)
    if _token='(' then begin
      pushfpa(sem_)
    End Else
    (* если закрывающая, то вытащим...*)
    If _token=')' then begin
      (* в стеке должны быть скобки *)
      if Emptyfpa then errorMsg(Input,') without (');
      (* почистим семантический стек *)
      flushsem;
      popfpa;
    End Else

    If _Token = ';' Then flushsem Else

    If _Token = ',' Then flushsem Else

    Begin
      while(not Emptysem)and(lt_pryor(get_string,_token))do begin
        os:=popsem(typ,ad);
        Enter(os,typ,ad);
      end;
      pushsem(_token,_token_type,a);
      a:=false;
    End;
          (* разбираем, пока не встретится ";" или оператор *)
  Until (_Token = ';') or (_Token_Type = _COMMAND);
  (* если стек скобок не пуст, значит, одна или более скобок не закрыты*)
  If not Emptyfpa then errorMsg(Input,') expected');
  (* очистим семантический стек *)
  flushsem;
  (* если оператор, то вернем его назад во входной поток *)
  if _Token_Type = _COMMAND then putback;
end;

Procedure ExecParse;
Begin
  PutBack;
  Parser^.Parse;
End;

(*Function ExecCond:JumpType;
Var
 Typ:E_TYP;
Begin
{  ExecParse;}
  Typ:=PopT;
  If Typ In [_je,_jne,_jg,_jl,_jge,_jle] Then Begin
    c^.cCode($5B);                       {pop bx}
    c^.cWord($D83B);                     {cmp bx,ax}
    c^.cCode($58);                       {pop ax}
    Case Typ Of
      _je  : ExecCond:=__Jz;
      _jne : ExecCond:=__Jnz;
      _jg  : ExecCond:=__Jg;
      _jl  : ExecCond:=__Jl;
      _jge : ExecCond:=__Jge;
      _jle : ExecCond:=__Jle;
    End;
  End Else Begin
    c^.cWord($C00B);            {or ax, ax}
    c^.cCode($58);              {pop ax}
    ExecCond:=__Jnz;
  End;
End;*)

begin
  FS:=Nil;
  {T_POS:=1000;}
  parser:=new(pstack,init);
end.