Unit ds2x86;
Interface
Uses
  d2type,d2tabx86;

Procedure ill;
{---}
Procedure exec_const;
Procedure exec_type;
Procedure exec_module;
Procedure exec_library;
Procedure exec_use;
Procedure exec_usebin;
Procedure exec_inline;
Procedure exec_if;
Procedure exec_ifn;
Procedure exec_then;
Procedure exec_else;
Procedure exec_elsif;
Procedure exec_elsifn;
Procedure exec_endif;
Procedure exec_for;
Procedure exec_in;
Procedure exec_next;
Procedure exec_cycle;
Procedure exec_sub;
Procedure exec_vect;
Procedure exec_recur;
Procedure exec_return;
Procedure exec_vars;
Procedure exec_repeat;
Procedure exec_until;
Procedure exec_while;
Procedure exec_whend;
Procedure exec_do;
Procedure exec_loop;
Procedure exec_cont;
Procedure exec_break;
Procedure exec_exit;
Procedure exec_new;
Procedure exec_case;
Procedure exec_of;
Procedure exec_end;
{---
Procedure exec_parse; }

Procedure compile(Typ:Pr_Type;Save:Boolean;What:OpenString);

Var
  local  : word;    (* размер локальных параметров *)
  frame  : word;    (* начало фрейма для статических процедур *)
  LINK   : WORD;
  FRD    : WORD;
  InlineFlag : Boolean;


Var
  CT:tHash;

Implementation

Uses
  dengine,dt2x86,da2x86,D2Libr,D2Comp,DoS;


type

   p_fix = ^ex_fix;
   ex_fix = Record
     addr : word;
     next : p_fix;
   end;

   prstack = ^trstack;
   trstack = record
     typ:rsvType;      (* operator type *)
     main_loc,
     add_loc:word;
     fix:p_fix;
     next:prstack;
   end;


var
  rstack : prstack;

  Procedure ill;
  Begin
    ErrorMsg(Input,'error in statement')
  End;


procedure Add(typ_:RsvType);
var
  tmp:prstack;
begin
  new(tmp);
  tmp^.typ:=typ_;
  tmp^.fix:=nil;
  tmp^.next:=rstack;
  rstack:=tmp;
end;

procedure del;
var
  tmp:prstack;
  d:p_fix;
begin

  tmp:=rstack;

  While tmp^.fix <> Nil Do Begin
    c^.fLabel(tmp^.fix^.addr);
    d:=tmp^.fix;
    tmp^.fix := tmp^.fix^.next;
    dispose(d);
  End;

  rstack:=rstack^.next;
  dispose(tmp);
end;

function get:prstack;
begin
  if rstack=nil then
    get:=nil
  else
    get:=rstack;
end;

type
  SR = Set Of RsvType;

Function GetRsvPtr(Rsv:SR):pRstack;
Var
  Pos:pRstack;
Begin
  Pos:=RStack;
  While (Pos<>Nil) And Not(Pos^.Typ In Rsv) Do Pos:=Pos^.Next;
  GetRsvPtr:=Pos;
End;

Procedure AddFix(Var Ptr:pRstack);
Var
  _fix : P_fix;
Begin
  new(_fix);
  _fix^.next:=Ptr^.fix;
  c^.fJump(__Jmp,_fix^.addr);
  ptr^.fix:=_fix;
End;


{----------- вспомогательные ф-ии синтаксического разбора ------------}


Procedure Match(Sym:RsvType);
Begin
  If _tok=Sym Then
    PutBack
  Else
    ErrorMsg(Input,Names^[Sym]+' expected')
End;

Procedure MatchSym(Sym:Char);
Begin
  Token;
  If _token<>Sym Then ErrorMsg(Input,Sym+' expected')
End;

Function IfSym(Sym:Char):Boolean;
Begin
  Token;
  If _token=Sym Then Begin
    Token;
    IfSym:=True
  End Else Begin
    PutBack;
    IfSym:=False
  End;
End;


Function read_dim:word;
Begin
  if IfSym('[') then begin
    con^.checkconst(_token,_token_type,_tok,_number_tok);
    if _token_type = _NUMBER then read_dim:=_Number_Tok;
    MatchSym(']');
  end else
    read_dim:=0;
End;

Procedure checkvar;
Begin
{  token;}
  con^.checkconst(_token,_token_type,_tok,_number_tok);
  if (_token_type <> _VARIABLE)and(_token_type<>_QUOTE) then errorMsg(Input,'identifier expected');
End;

Function IsPublic:Boolean;
Begin
  IsPublic:=IfSym('*');
  PutBack;
End;

Procedure CanExport(var V:pTerm);
Begin
  if ispublic then v^.hidd:=_HIDDMOD else v^.hidd:=hiddtype;
End;

procedure fixSerror(errt:rsvType;error:String);
begin
  case errt of
    _IF    :errorMsg(Input,'error in if statement');
    _FOR   :errorMsg(Input,'error in for statement');
    _REPEAT:errorMsg(Input,'error in repeat statement');
    _WHILE :errorMsg(Input,'error in while statement');
    _DO    :errorMsg(Input,'error in do statement');
    _SUB   :errorMsg(Input,'error in sub statement');
    _UNTIL :errorMsg(Input,'error in until statement');
    _LOOP  :errorMsg(Input,'error in loop statement');
    _CYCLE :errorMsg(Input,'error in cycle statement');
    else
      errorMsg(Input,Error);
  end;
end;


{------------------- вектора ------------------------------------}

Procedure exec_const;
var
  name:string;
Begin
  Token;
  repeat
    name:=_token;
    MatchSym('=');
    token;
    con:=new(pconst,addconst(con,name,_token,_token_type,_tok,_number_tok));
  until Not IfSym(',')
End;

Procedure exec_type;
Begin

End;

Procedure exec_module;
Begin
  token;
  checkvar;
  {addt(_token,_VARIABLE,1,_HIDDMOD);}
  ProcType:=_MOD;
End;

Procedure exec_library;
Begin
  token;
  checkvar;
  {addt(_token,_VARIABLE,1,_HIDDMOD);}
  ProcType:=_LIB;
End;


Procedure Exec_Use;
Var
  v:pterm;
  Path:String;
Begin
  token;
  repeat
    checkvar;
    v:=Tab.CheckTerm(_token);
    if v=nil then begin
      Path:=fsearch(_token+'.D2',ModuleDir);
      If Path='' Then errorMsg(Input,'cann''t load module');
      Compile(_LIB,False,Path);
    end else errorMsg(Input,'identifier allready defined');
  until not ifsym(',');
  matchsym(';')
End;

Procedure exec_usebin;
var
  v:pterm;
  Path:String;
Begin
  token;
  repeat
    checkvar;
    v:=Tab.CheckTerm(_token);
    if v<>nil then errorMsg(Input,'identifier allready defined');
    Path:=fsearch(_token+'.D2',ModuleDir);
    If Path<>'' Then Compile(_LIB,False,Path) Else LibLoad(_token);
  until not ifsym(',');
  matchsym(';')
End;

Procedure exec_inline;
Var
  Pr : Byte;
  V,Sub : PTerm;
  Out : PComp;
Begin
  If CurSub<>Nil Then Out:=C Else Begin
    Out:=New(PComp,Init(0,1024));
    Token;
    sub:=Tab.CheckTerm(_token);
    if sub=nil then
      sub:=Tab.AddTerm(_token,_SUB,1,hiddtype)
    else begin
      if sub^.par<>0 then errorMsg(Input,'subroutine allready defined');
      sub^.typ:=_SUB;
    end;
    pr:=byte(read_dim);
    if pr=0 then sub^.par:=1 else sub^.par:=pr;
    sub^.extrn:=TRUE;
  End;

  MatchSym('(');
  Repeat
    Token;
    Case _Token_Type Of
      _NUMBER:       Out^.cByte(_Number_Tok);
      _QUOTE:        Begin
                       Out^.cWord($9090);
                       AddString(Out^.cIP,_token);
                     End;
      _VARIABLE:     Begin
                       v:=Loc.CheckTerm(_token); {local parameter?}
                       If v=nil Then Begin   {no...}
                         v:=Tab.CheckTerm(_token);
                         if v=nil then Begin
                           ErrorMsg(Input,'undefined identifier '+_token);
                         End Else Begin
                           Out^.cWord(V^.offs);
                         End;
                       End Else Begin {local}
                         If V^.Par>$7F Then
                           c^.cWord(V^.Par) {parNo}
                         Else
                           c^.cByte(V^.Par); {parNo}
                       End;
                     End;
    End;
    Token;
  Until _token <> ',';
  PutBack;
  MatchSym(')');

  If Out<>C Then Begin
    Sub^.Size:=Out^.cIP;
    GetMem(Sub^.Body,Out^.cIP);
    Move(Out^.Buf^,Sub^.Body^,Out^.cIP);
    Dispose(Out,Done);
    FixStrs;
  End;
End;



  Function InvJump(Jump:JumpType):JumpType;
  Begin
    Case Jump Of
      __Jz : InvJump:=__Jnz;
      __Jnz : InvJump:=__Jz;
      __Jl : InvJump:=__Jge;
      __Jg : InvJump:=__Jle;
      __Jle : InvJump:=__Jg;
      __Jge : InvJump:=__Jl;
      Else
        ErrorMsg(Input,'unknown jump type');
    End;
  End;



{=========================================================}

{--------- mov [bp+...],value -------------}

Procedure MovBPVal(Size:Byte;Disp:Integer;Value:Word);
Begin
  Case Size Of
    1 : c^.cByte($C6);
    2 : c^.cByte($C7);
  End;
  If Abs(Disp)<=$7F Then Begin
    c^.cByte($46);
    c^.cByte(Disp)
  End Else Begin
    c^.cByte($86);
    c^.cWord(Disp)
  End;
  Case Size Of
    1 : c^.cByte(Value);
    2 : c^.cWord(Value);
  End;
End;

Procedure SubBP(Disp:Integer);
Begin
  If Abs(Disp)>$7F Then Begin
    c^.cWord($ED81);
    c^.cWord(Disp);
  End Else Begin
    c^.cWord($ED83);
    c^.cByte(Disp);
  End;
End;

Procedure MovBPAx(Par:Word);
Begin
  If Par>$7F Then Begin
    c^.cWord($8689);c^.cWord(Par); {mov [bp+par],ax   //pop w,[bp+par]}
  End Else Begin
    c^.cWord($4689);c^.cByte(Par); {mov [bp+par],ax   //pop w,[bp+par]}
  End;
End;

{---- vect jump here ----}

      Procedure v_jump;far;
      Begin
        c^.cByte($E9); {jmp 0 }
        c^.cWord(0);
      End;

      Procedure no_jump;far;
      Begin

      End;

      Var vJump : Procedure;




Procedure SubHeader(Sub:pTerm;NL:Word;L:PTerm);

  Procedure DynamicEnter;
  Begin   (* 6 or 7 bytes *)
    (* proc adress *)
    Sub^.Offs:=c^.cIP;
    (* enter code *)
    If Proctype = _MOD Then Begin
      vJump;
      c^.cInline('8F46FE');            {pop w,[bp-2]}
      SubBP(NL+2);                     {sub bp,NL+2}
    End;{ Else
      If NL<>0 Then SubBP(NL);         {sub bp,NL}
    (* local parameters *)
    while L<>nil do begin
      if L^.typ=_VAR then begin
        MovBPAx(L^.par);
        c^._pop_ax
      end else
      if L^.typ=_LOCAL then begin
        MovBPVal(SizeOf(Word),L^.Par,L^.Offs);
      end;
      L:=L^.next;
    end;
  End;

  Procedure StaticEnter;
  Begin (* 6 bytes + size for local variables *)
    (* proc adress *)
    frame:=c^.cIP+2;
    c^.cPattern($90,local+2); (* size for frame *)
    Sub^.Offs:=c^.cIP;
    (* enter code *)
    If Proctype = _MOD Then Begin
      vJump;
      c^.cWord($068F);                 {pop w,[frame]}
      c^.cWord(frame-2);
    End Else
      ErrorMsg(Input,'must be dynamic procedure (use $V+)');
    (* local parameters *)
    while L<>nil do begin
      if L^.typ=_VAR then begin
        c^.cByte($A3);
        c^.cWord(L^.par); {mov [frame+lpar],ax}
        c^._pop_ax
      end else
      if L^.typ=_LOCAL then begin
        c^.cWord($06C7);
        c^.cWord(L^.Par);
        c^.cWord(L^.Offs);
      end;
      L:=L^.next;
    end;

  End;

Begin
  (* debug info *)
  If (ProcType = _LIB) Or dbgFLG Then Begin
    c^.cWord(LINK);
    If ProcType = _LIB Then
      LINK:=c^.cIP-2-$100
    Else
      LINK:=c^.cIP-2;
    c^.cByte(27);
    c^.cByte(Sub^.Par);
    c^.cByte(Local);
    c^.cAscii2z(pTerm(CurSub)^.Name^.GetStr);
  End;
  FRD:=c^.cIP;
  (* enter code *)
  If frame=0 Then
    DynamicEnter
  Else
    StaticEnter;
End;

Procedure AddToTable(Var Sub:pTerm);
Begin
  Token;
  CheckVar;

  sub:=Tab.CheckTerm(_token);
  if sub=nil then
    sub:=Tab.AddTerm(_token,_SUB,1,hiddtype)
  else
    if sub^.offs<>0 then begin
      warningMsg(Input,'subroutine allready defined');
      sub:=Tab.AddTerm(_token,_SUB,1,hiddtype)
    end;
  CurSub:=sub;
End;



Procedure exec_vect;
Begin
  vJump:=v_Jump;
  exec_sub;
  vJump:=no_Jump;
End;

Procedure exec_sub;
Var
  sub,v,s:pterm;
  pr:word;
  params:word;
Begin
  if cursub <> Nil then errorMsg(Input,'subroutine can''nt be nested');

  AddToTable(Sub);
  CanExport(Sub);

  Add(_SUB);

  local:=0;
  params:=0;
  If dnmFLG Then frame:=0 Else frame:=c^.cIP+2;
  pr:=byte(read_dim);
  if pr=0 then sub^.par:=1 else sub^.par:=pr;

  Token;
  if (_token_type=_COMMAND) and (_tok=_VAR) then begin
    repeat
      token;
      checkvar;
      v:=Loc.AddTerm(_token,_NIL,frame+local,_HIDDMOD);
      pr:=read_dim;
      if pr = 0 then pr:=2;
      inc(params);
      inc(local,pr);

      token;
      if _token = '*' then begin
        v^.typ:=_VAR;
        token;
      end else

      if _token = '<' then begin
        token;
        con^.checkconst(_token,_token_type,_tok,_number_tok);
        v^.typ:=_LOCAL;
        Case _Token_Type of
          _NUMBER:
             Case Pr Of
               1 :v^.offs:=_Number_Tok;
               2 : v^.offs:=_Number_Tok;
               Else
                 ErrorMsg(Input,'parameter is too big')
             End;
          _QUOTE:
            Begin
              v^.offs:=c^.cIP;
              c^.cAscii2z(_token);
            End;
          _VARIABLE:
            Begin
              s:=Tab.CheckTerm(_token);
              If s=nil Then ErrorMsg(Input,'unknown identifier');
              v^.offs:=s^.offs;
            End;
        End;
        MatchSym('>');
        token;
      end;

    until  _token <> ',';
    PutBack;
    MatchSym(';');
  end else
    putback;
  SubHeader(Sub,Local,Loc.Itm);
  Sub^.Loc:=Params;
End;

Procedure exec_recur;
Begin
  If CurSub=Nil Then ErrorMsg(Input,'error in statement');
  c^.cByte($E8);
  c^.cWord(pTerm(curSub)^.offs-c^.cIP-2)
End;


Procedure exec_return;
Var
  i:byte;
{  d:p_fix;}
Begin
  if get^.typ <> _SUB then fixserror(get^.typ,'return without sub');
  if local>0 then Loc.Clear;
  {fix ip }

{  While e_fix <> Nil Do Begin
    c^.fLabel(e_fix^.addr);
    d:=e_fix;
    e_fix := e_fix^.next;
    dispose(d);
  End;}

   del;    { <--- fix up must be here! }

  If proctype = _MOD Then
    If frame=0 then begin          {6 bytes for dynamic call}
      SubBP(-local-2);             {add bp, local+2}
      c^.cInline('FF66FE');        {jmp w,[bp-2]}
    end else begin                 {4 bytes for static call}
      c^.cWord($26FF);             {}
      c^.cWord(frame-2);           {jmp [frame]}
    end;


{  Else
    If Local>0 Then SubBP(-local);}

  InlineFlag := False;
  FixStrs;
  c^.AllFixUp;
{  WriteLn(c^.cIP-FRD:6,' bytes');}
  CurSub:=Nil;
End;

Procedure Default(pr:word);
var
  w:word;
  s:pterm;
begin
  if ifsym('<') then begin
    W:=0;
    Repeat
      con^.checkconst(_token,_token_type,_tok,_number_tok);
      Case _token_type Of
        _QUOTE:begin
          c^.cWord(0);
          AddString(c^.cIP,_token);
          Inc(w,2);
        end;
        _VARIABLE:begin
          s:=Tab.CheckTerm(_token);
          If s=Nil Then ErrorMsg(Input,'unknown identifier');
          c^.cWord(s^.offs);
          Inc(w,2);
        end;
        _NUMBER:If Pr=2 Then Begin
            c^.cWord(_Number_Tok);
            Inc(W,2);
          End Else Begin
            c^.cByte(_Number_Tok);
            Inc(W);
          End;
        Else
          ErrorMsg(Input,'error in declaration');
      End;
      Token;
    Until Pr=W;
    PutBack;
    MatchSym('>');
{    Token;}
  End Else
    For w:=1 To Pr Do c^.cByte(0);
end;

Procedure exec_vars;
Var
  v:pterm;
  pr:word;
Begin
  if cursub=Nil then begin
     token;
     repeat
       checkvar;
{       write(_token:32,'  ...  ');}
       v:=Tab.CheckTerm(_token);
       if v=nil then
         v:=Tab.AddTerm(_token,_VAR,1,hiddtype)
       else
         errorMsg(Input,'identifier('+_token+') allready defined');

{       CanExport(v);}
       pr:=read_dim;
       if pr = 0 then pr:=2;
       v^.offs:=c^.cIP;
       default(pr);
{       writeln(pr:6,' bytes');}
     until not ifsym(',');
     MatchSym(';');
  end else
    ErrorMsg(Input,'identifier cann''t be define here');
End;

Procedure exec_new;
Begin

End;


{================ операторы управления процессом исполнения ========================}

(*-------------- if then {elseif then  }[else ] fi --------------*)
Procedure exec_if;
Begin
  add(_IF);
End;

Procedure exec_ifn;
Begin
  add(_IFN);
End;

Procedure exec_then;
Begin
  Case get^.typ Of
    _IF:c^.fJc(__Jz,get^.main_loc);
    _IFN:c^.fJc(__Jnz,get^.main_loc);
    Else fixserror(get^.typ,'if expected');
  End;
  get^.typ:=_THEN;
End;

Procedure exec_else;
Begin
  if get^.typ <> _THEN then fixserror(get^.typ,'then expected');
  c^.fJump(__Jmp,get^.add_loc);
  c^.fLabel(get^.main_loc);
  get^.typ:=_ELSE;
End;

Procedure elsif;
Begin
  if get^.typ <> _THEN then fixserror(get^.typ,'then expected');
  c^.fJump(__Jmp,get^.add_loc);
  c^.fLabel(get^.main_loc);
  get^.typ:=_ELSIF;
End;

Procedure exec_elsif;
Begin
  elsif;
  add(_IF);
End;

Procedure exec_elsifn;
Begin
  elsif;
  add(_IFN);
End;

Procedure exec_endif;
Begin
  if get^.typ = _THEN then
    c^.fLabel(get^.main_loc)
  else
  if get^.typ = _ELSE then
    c^.fLabel(get^.add_loc)
  else
    errorMsg(Input,'error in if statement');
  del;
  while get^.typ = _ELSIF do begin
    c^.fLabel(get^.add_loc);
    del;
  end;
End;

{------------- for in do next ----------------}

var
  for_stack : array[1..64] of record
    id : word;
    local : boolean;
    loc : word;
    pack : word
  end;
  for_pos:byte;

Procedure exec_for;
var
  cnt:byte;
  val:pterm;
Begin
  add(_FOR);
  c^._push_ax;
  c^.cByte($E8); c^.cWord(0); get^.main_loc:=c^.cIP; {call _data}
  cnt:=0;
  token;
  repeat
    inc(cnt);
    inc(for_pos);
    checkvar;
    val:=Loc.CheckTerm(_token);
    If val = nil Then Begin
      val:=Tab.CheckTerm(_token);
      if (val=nil) then errorMsg(Input,'identifier of counter expected');
      for_stack[for_pos].id:=val^.offs;
      for_stack[for_pos].local:=false;
    End Else Begin
      for_stack[for_pos].id:=val^.par;
      for_stack[for_pos].local:=true;
    End;
    for_stack[for_pos].pack:=cnt;
  until not ifsym(',');
  token;
  Match(_IN);
End;

Procedure exec_in;

  Procedure T;
  Begin
    Token;
    con^.checkconst(_token,_token_type,_tok,_number_tok);
  End;

Var
  pos:byte;
  w1:word;
  Flg:Boolean;
Begin
  if get^.typ<>_FOR then fixserror(get^.typ,'for expected');
  token;

  case _token_type of

  _VARIABLE: errorMsg(Input,'invalid data set');

  _QUOTE: c^.cAscii2z(_token);

  _NUMBER:

  repeat
    w1:=_Number_Tok;

    T;

    If _token=',' Then Begin
      c^.cWord(w1);
      T;
      If _token_type <> _NUMBER then errorMsg(Input,'must be number');
      Flg:=False;
    End Else If _token='..' Then Begin
      T;
      If _token_type <> _NUMBER then errorMsg(Input,'must be number');
      For w1:=w1 To _Number_Tok Do c^.cWord(w1);
      Flg:=False;
    End Else Begin
      PutBack;
      Flg:=True
    End;

  until Flg;

  end;


  c^.iWord(get^.main_loc-2,c^.cIP-get^.main_loc); {fix up call _data}
  c^.bLabel(get^.add_loc);
  c^.cCode($58); {pop ax}
  for pos:=for_stack[for_pos].pack-1 downto 0 do begin
    c^.cCode($56); {push si}
    c^.cWord($F08B); {mov si,ax}
    c^.bLabel(for_stack[for_pos-pos].loc);
    c^._push_ax;
    c^.cByte($AD); {lodsw}
    if for_stack[for_pos-pos].local Then Begin
      c^.cWord($8689);c^.cWord(for_stack[for_pos-pos].id); {mov w,[bp+par],ax}
    End Else Begin
      c^.cByte($A3);c^.cWord(for_stack[for_pos-pos].id); {mov w,id,ax}
    End;
    c^._pop_ax
  end;
  Token;
  Match(_DO);
End;

Procedure exec_next;
Begin
  if get^.typ <> _FOR then fixserror(get^.typ,'next without for');
  Repeat
    c^.cWord($FE81);c^.cWord(get^.add_loc-1);{cmp si, _data}
    c^.bJump(__Jl,for_stack[for_pos].loc);
    c^.cCode($5E);{pop si}
    dec(for_pos);
  Until for_stack[for_pos+1].pack=1;
  c^._pop_ax;
  del;
End;

{---------- cycle loop ---------------}

Procedure exec_cycle;
Begin
  add(_CYCLE);
End;

{-------------- repeat until loop --------------}

Procedure exec_repeat;
Begin
  add(_REPEAT);
  c^.bLabel(get^.main_loc);
End;

Procedure exec_until;
Begin
  if get^.typ <> _REPEAT then fixserror(get^.typ,'until without repeat');
  get^.typ:=_UNTIL;
End;

{------------- while  ---------------}

Procedure exec_while;
Begin
  add(_WHILE);
  c^.bLabel(get^.main_loc);
End;

Procedure exec_whend;
Begin
  If get^.typ <> _DO Then FixSError(_tok,'error in while statement');
  c^.bJump(__Jmp,get^.main_loc);
  c^.fLabel(get^.add_loc);
  del;
End;

{------------ do loop  & while do wend ----------}

Procedure exec_do;
Begin
  if get^.typ=_WHILE then begin
    get^.typ:=_DO;
    c^.fJc(__Jz,get^.add_loc);
  end else
  If get^.typ=_CYCLE then begin
    c^.cCode($91);               {xchg cx, ax}
    c^._push_ax;
(*    c^.cCode($51);                 { push cx }
    c^.cWord($C88B);               { mov cx, ax }*)
    c^.bLabel(get^.main_loc);
  end else
  If get^.typ=_FOR then
    (* nothing do *)
  else begin
    add(_DO);
    c^.bLabel(get^.main_loc);
  end;
End;

{ --------------- do loop & repeat until loop & cycle loop --------}

Procedure exec_loop;
Begin
  if (get^.typ = _DO) then
    c^.bJump(__Jmp,get^.main_loc)
  else
  if (get^.typ = _UNTIL) then
    c^.bJc(__Jz,get^.main_loc)
  else
  if (get^.typ = _CYCLE) then begin
    If Abs(Integer(get^.main_loc-c^.cIP-2)) > LenShortJmp Then ErrorMsg(Input,'loop too far');
    c^.cByte($E2);c^.cByte(get^.main_loc-c^.cIP-1); {loop l}
    c^.cCode($59);                           {pop cx}
    c^._pop_ax;
  end else
    fixserror(get^.typ,'loop without do');
  del;
End;

Procedure exec_case;
Begin
  Add(_CASE);
End;

Procedure exec_of;
Begin
  c^._push_ax;
End;

Var
  FINISH:boolean;

Procedure exec_end;
Begin
  FINISH:=true;
{  Token;
  If get^.typ = _SUB Then
    exec_return
  Else Begin
    If get^.typ <> _tok Then FixSError(_tok,'error in statement');
    Procs[_tok,Done];
    del;
  End;}
End;

Const Cycles : SR = ( [_WHILE,_UNTIL,_REPEAT,_DO,_CYCLE]);

Procedure exec_cont;
Var
  G:pRstack;
Begin
(* do loop / while wend / cycle loop / repeat until *)
  G:=GetRsvPtr(CYCLES);
  If G<>Nil Then
    Case G^.Typ Of
    _CYCLE: Begin
      c^.cByte($E2);
      c^.cByte(G^.main_loc-c^.cIP-1); {loop l}
    End;
    _WHILE,_REPEAT,_DO,_UNTIL: c^.bJump(__Jmp,G^.main_loc);  {jmp l}
  End Else
    errorMsg(Input,'can''t continue cycle');
End;

Procedure exec_break;
Var
  Fix:pRstack;
Begin
(* do loop / while wend / cycle loop / repeat until *)
  Fix:=GetRsvPtr(Cycles);
  If Fix=nil Then errorMsg(Input,'must be use in cycle');
  AddFix(Fix);
End;



Procedure exec_exit;
Var
  fix : pRstack;
Begin (*
  If frame=0 then begin          {6 bytes for dynamic call}
    SubBP(-local-2);             {add bp, local+2}
    c^.cInline('FF66FE');        {jmp w,[bp-2]}
  end else begin                 {4 bytes for static call}
    c^.cWord($26FF);             {}
    c^.cWord(frame-2);           {jmp [frame]}
  end;  *)
  fix := GetRsvPtr([_SUB]);
  If fix=nil Then ErrorMsg(Input,'must be use in subroutine');
  addFix(Fix);
End;


{==================== конец векторов ==========================}



Procedure Compile;

  Var
    main:word;

            Procedure ModuleHeader;
            Begin
              c^.cCode($FC);                                 {cld}
              c^.cCode($58);                                 {pop ax}
              c^.cByte($BD);c^.cWord(High(Word)-10);         {mov bp, ret_stk }
              c^.cByte($BC);c^.cWord(High(Word)-10-memSR);   {mov sp, ar_stk }
              If jmpFLG Then Begin
                c^.cCode($50);                                 {push ax}
                c^.cByte($E9);c^.cWord(0);main:=c^.cIP;        {jmp main }
              End Else Begin
                c^.cByte($E8);c^.cWord(0);main:=c^.cIP;        {call main }
                c^.cInline('B8004CCD21'); {mov ax,4C00 ; int 21 }
              End;
            End;

            Procedure LibraryHeader;
            Begin
              c^.cInline('6C69623264'); {lib2d}
              c^.cWord(0);main:=c^.cIP;    {offs of first word}
            End;

            Procedure CompileBody;
            Begin
              putback;
              repeat
                token;
                Case _Token_Type Of (* Проверка на соответствие оператору языка *)
                  _VARIABLE,
                  _NUMBER,  (* атом *)
                  _QUOTE   :if cursub<>Nil then
                     ExecParse
                     else
                     ErrorMsg(Input,'syntax error');
                  _COMMAND :Func; (* это команда *)
                  _DELIMITER:if (_token<>';')and(_token<>'') then ExecParse;
                  _FINISHED:;
                ELSE
                  errorMsg(Input,'syntax error');
                end;
              until FINISH;
            End;

    Var
              sub:pterm;


            Procedure CompileModule;
            Begin
              proctype:=_MOD;
              hiddtype:=_HIDDMOD;
              ModuleHeader;
              CompileBody;
              sub:=Tab.CheckTerm('main');
              if (sub=nil)or(sub^.par=0)then errorMsg(Input,'subroutine main must be defined');
              c^.iWord(main-2,sub^.offs-main); {fix up main addres}
            End;
            Procedure CompileLibrary;
            Begin
              proctype:=_LIB;
              hiddtype:=_HIDDLIB;
              LibraryHeader;
              CompileBody;
              Tab.HiddAll;
              c^.iWord(main-2,LINK);
            End;

    procedure FixUpSubs;
    Var
      I:Byte;
      Pos:pterm;
      Fix:pfixup;
    begin
      For I:=Low(Byte) To High(Byte) Do
        If I In Tab.Hidd Then Begin
          Pos:=Tab.Table[I];
          While Pos<>Nil Do Begin
            Fix:=Pos^.FixUp;
            While Fix<>Nil Do Begin
              c^.iWord(Fix^.Where-2,Pos^.offs-Fix^.Where);
              Fix:=Fix^.Next;
            End;
            Pos:=Pos^.Next;
          End;
        End;
    End;


Begin
  if ( CT.CheckTerm(what)=nil) then begin
    CT.AddTerm(What,_MODULE,0,_HIDDMOD);
    InitInput(what);
    FINISH:=false;
    {Write('compiling: ',what,' ... ');}
  {-------------------------------------------------------}
    token;
    If _tok=_MODULE  Then
      CompileModule
    Else
    If _Tok=_LIBRARY Then
      CompileLibrary
    Else
      ErrorMsg(Input,'module or library expected');
    FixUpSubs;
    Tab.IdentCheck;
{    WriteLn(Input^.line,' lines');}
    DoneInput;
  End;
{  If Save Then c^.Save(Target+DefExt[proctype])}
End;


Begin
  vJump:=no_jump;
  for_pos:=0;
  RStack:=nil;
  LINK:=0;
  CT.Init;
  CurSub:=Nil;
  InlineFlag := False;
End.