define @emNOTAVAIL   "Не pеализовано"
define @emINTERNAL   "Внутpенняя ошибка"
define @emNOMEMORY   "Недостаточно памяти"
define @emEOF        "Конец файла"
define @emWRITEERR   "Ошибка записи"
define @emTHENEXP    "Пpопущено then"
define @emCOLON      "Пpопущено двоеточие"
define @emDOEXPECTED "Пpопущено do"
define @emLOOP       "loop/exit вне цикла"
define @emVOID       "Тип void недопустим"
define @emTYPE       "Несоответствие типов"
define @emBOOLEAN    "Тpебуется логическое условие"
define @emPOINTER    "Ссылка недопустима"
define @emNOPTR      "Тpебуется ссылка"
define @emLVALUE     "Пpисваивание недопустимо"
define @emEXPECTED   "Пpопущен идентификатоp"
define @emUNDEFINED  "Идентификатоp не опpеделен"
define @emDOUBLE     "Повтоpное описание"
define @emEMPTY      "Нет списка полей"
define @emSIZE       "Слишком длинный идентификатоp"
define @emASSIGN     "Пpопущено ="
define @emSTRING     "Пpопущена двойная кавычка"
define @emCHAR       "Пpопущена кавычка"
define @emNUMBER     "Ошибка в константе"
define @emOVERFLOW   "Константа слишком велика"
define @emARRAY      "Пустой массив"
define @emSTRUCTURE  "Стpуктуpа слишком велика"
define @emNOBRACKET  "Скобка недопустима"
define @emSBRACKET   "Пpопущена скобка"
define @emCBRACKET   "Пpопущена скобка"
define @emADDR       "Невозможно вычислить адpес"
define @emUNDEFOPR   "Опеpация неопpеделена"
define @emCOMMA      "Пpопущена запятая"
define @emEQUAL      "Тpебуется одинаковый поpядок ссылок"
define @emSEMICOLON  "Пpопущена точка с запятой"
define @emFIELD      "Пpопущено поле"
define @emFUNCTION   "Описание функции недопустимо"
define @emDBEXP      "Пpопущено db"

define  Smax      65520

define  sbSIZE    16384 //  4096
define  dbSIZE    16384 // 38912
define  idSIZE       16
define  wtSIZE       24
define  gtSIZE     1024
define  ttSIZE       16
define  ftSIZE       64
define  stSIZE       64
define  ptSIZE       96
define  dtSIZE       64
define  vtSIZE       64
define  itSIZE      128
define  ctSIZE      128
define  cbSIZE     8192 //  4096
define  ltSIZE     1024 //   512
define  jtSIZE       64
define  ssSIZE       64

define  gtIDX     $01FF
define  gtWORD    $0200
define  gtDEF     $0400
define  gtTYPE    $0800
define  gtDATA    $1000
define  gtSUB     $2000
define  gtPARM    $4000
define  gtVAR     $8000

define  idIF          0
define  idTHEN        1
define  idELSEIF      2
define  idELSE        3
define  idSELECT      4
define  idCASE        5
define  idDEFAULT     6
define  idWHILE       7
define  idDO          8
define  idLOOP        9
define  idEXIT       10
define  idINC        11
define  idDEC        12
define  idRETURN     13
define  idASM        14
define  idNULL       15
define  idCONST      16
define  idDEFINE     17
define  idSTRUCT     18
define  idBEGIN      19
define  idEND        20

define  ttVOID        0
define  ttBOOL        1
define  ttCHAR        2
define  ttBYTE        3
define  ttWORD        4

define  srNO          0
define  srAX          1
define  srCS          2
define  srDS          3
define  srBP          4
define  srBN          5
define  srSP          6
define  srES          7

define  rgAX          0
define  rgDX          1
define  rgDI          2
define  rgES          3

struct long
  word Low;
end

struct OpInfo
  word pType;
  word Seg;
  word Ofs;
  word High;
  word nPtr;
  word Index;
  word Value;
end

struct TT
  char Name [idSIZE];
  word pField;
  word nField;
  word Size;
end

struct FT
  char Name [idSIZE];
  word pType;
  word pIndex;
  word nIndex;
  word nPtr;
  word Ofs;
end

struct ST
  char Name [idSIZE];
  word pType;
  word pParm;
  word nParm;
  word nPtr;
  word Ofs;
end

struct PT
  char Name [idSIZE];
  word pType;
  word nPtr;
  word Ofs;
  word pGlb;
  word vGlb;
end

struct VT
  char Name [idSIZE];
  word pType;
  word pIndex;
  word nIndex;
  word nPtr;
  word Ofs;
  word pGlb;
  word vGlb;
end

struct DT
  char Name [idSIZE];
  word pType;
  word pIndex;
  word nIndex;
  word nPtr;
  word Ofs;
end

struct CT
  char Name [idSIZE];
  word pType;
  word nPtr;
  word Low;
end

struct LT
  long IP;
  word Ofs;
end

char @WTabl[wtSIZE];

word GTabl [gtSIZE];
word nGlb;

TT   TTabl [ttSIZE];
word nType;

FT   FTabl [ftSIZE];
word nField;

ST   STabl [stSIZE];
word nSub;

PT   PTabl [ptSIZE];
word nParm;

VT   VTabl [vtSIZE];
word nVar;

DT   DTabl [dtSIZE];
word DSize;
word nData;

CT   CTabl [ctSIZE];
word nConst;

LT   LTabl [ltSIZE];
word nLoad;

char CBuff [cbSIZE];
word nByte;

word ITabl [itSIZE];
word nIndex;

long JTabl [jtSIZE];
word nJump;

word Stack [ssSIZE];
word SP;

word HTabl [512];

word Regs  [5];

word RSize;
word PSize;
word VSize;
word SSize;

word pSub;

word Loop;

char Buff  [sbSIZE];
word pChar;
word nChar;

byte Dest  [dbSIZE];
word pDest;
word pPred;
word fDest;

word IP;
word Line;

char Name  [13];
word F1;
word F2;

word isalpha(char Ch)
  if 'a'<=Ch & Ch<='z' then
    return 0;
  end

  if 'A'<=Ch & Ch<='Z' then
    return 0;
  end

  if Ch='_' then
    return 0;
  end

  return   1;
end

word isdigit(char Ch)
  if '0'<=Ch & Ch<='9' then
    return 0;
  end

  if Ch='$' then
    return 0;
  end

  return   1;
end

word strlen(char @Buff)
  word P=0;
  while Buff[P]!=#0 do
    inc P;
  end
  return P;
end

word strcmp(char @St1, @St2)
  word P=0;
  while TRUE do
    if St1[P]!=St2[P] then
      return 1;
    end
    if St1[P]=#0 then
      return 0;
    end
    inc P;
  end
end

word strchr(char @Buff; char Ch)
  if Buff[0]!=Ch then
    return 1;
  end
  if Buff[1]!=#0 then
    return 1;
  end
  return 0;
end

char @strcpy(char @Dst, @Src)
  word P=0;
  while Src[P]!=#0 do
    Dst[P]=Src[P];
    inc P;
  end
  Dst[P]=#0;
  return @Dst;
end

char @strcat(char @Dst, @Src)
  word P=strlen(@Dst);
  word Q=0;
  while Src[Q]!=#0 do
    Dst[P]=Src[Q];
    inc P;
    inc Q;
  end
  Dst[P]=#0;
  return @Dst;
end

word CharToWord(char Ch)
  asm db      08AH, 086H, 004H, 000H
  asm db      032H, 0E4H
end

void @Ptr(word Seg, Ofs)
  asm db      08BH, 086H, 004H, 000H
  asm db      08BH, 096H, 006H, 000H
end

word GetPSP()
  asm db      0B4H, 062H
  asm db      0CDH, 021H
  asm db      08BH, 0C3H
end

word create(char @Name)
  asm db      01EH
  asm db      0B4H, 03CH
  asm db      0B9H, 000H, 000H
  asm db      08BH, 096H, 006H, 000H
  asm db      08EH, 0DAH
  asm db      08BH, 096H, 004H, 000H
  asm db      0CDH, 021H
  asm db      01FH
end

word open(char @Name)
  asm db      01EH
  asm db      0B4H, 03DH
  asm db      0B0H, 000H
  asm db      08BH, 096H, 006H, 000H
  asm db      08EH, 0DAH
  asm db      08BH, 096H, 004H, 000H
  asm db      0CDH, 021H
  asm db      073H, 003H
  asm db      0B8H, 0FFH, 0FFH
  asm db      01FH
end

word read(word F; void @Buff; word N)
  asm db      01EH
  asm db      0B4H, 03FH
  asm db      08BH, 09EH, 00AH, 000H
  asm db      08BH, 08EH, 004H, 000H
  asm db      08BH, 096H, 008H, 000H
  asm db      08EH, 0DAH
  asm db      08BH, 096H, 006H, 000H
  asm db      0CDH, 021H
  asm db      01FH
end

word write(word F; void @Buff; word N)
  asm db      01EH
  asm db      0B4H, 040H
  asm db      08BH, 09EH, 00AH, 000H
  asm db      08BH, 08EH, 004H, 000H
  asm db      08BH, 096H, 008H, 000H
  asm db      08EH, 0DAH
  asm db      08BH, 096H, 006H, 000H
  asm db      0CDH, 021H
  asm db      01FH
end

word seek(word F; word P)
  asm db      01EH
  asm db      0B8H, 000H, 042H
  asm db      08BH, 09EH, 006H, 000H
  asm db      0B9H, 000H, 000H
  asm db      08BH, 096H, 004H, 000H
  asm db      0CDH, 021H
  asm db      01FH
end

void close(word F)
  asm db      0B4H, 03EH
  asm db      08BH, 09EH, 004H, 000H
  asm db      0CDH, 021H
end

void putc(char Ch)
  asm db      0B4H, 002H
  asm db      08AH, 096H, 004H, 000H
  asm db      0CDH, 021H
end

void puts(char @St)
  word P=0;
  while St[P]!=#0 do
    putc(St[P]);
    inc P;
  end
end

void outs(char @St)
  puts(@St);
  putc(#13);
  putc(#10);
end

char @Digit;

word str(word N; word S; char @Buff)
  if S>0 then
    dec S;
  end

  word P=0;
  if N>=10 | S>0 then
    P=str(N/10,S,@Buff);
  end

  Buff[P]=Digit[N%10];

  return P+1;
end

char @Str(word N; word S)
  char   @P="00000";
  P[str(N,S,@P)]=#0;
  return @P;
end

void Info()
  char Buff[128];
  putc(#13);
  puts(@strcat(@strcat(@strcat(@strcpy(@Buff,@Name),"("),@Str(Line,0)),")"));
end

void Stop(char @EM)
  Info ();
  puts (": ");
  puts (@EM);

  close(F2);
  close(F1);

  asm db      0B8H, 000H, 04CH
  asm db      0CDH, 021H
end

word Add(word A, B)
  word C1=A/256+B/256;
  word C0=A%256+B%256;

  C1=C1+C0/256;
  C0=C0%256;

  if C1>255 then
    return 65535;
  end

  return 256*C1+C0;
end

word Mul(word A, B)
  word A1=A/256;
  word A0=A%256;
  word B1=B/256;
  word B0=B%256;

  if A1*B1>0 | Add(A1*B0,A0*B1)>255 then
    return 65535;
  end

  return Add(256*(A1*B0+A0*B1),A0*B0);
end

word Val(char @Buff)
  word E=10;
  word L= 0;
  word H= 0;
  word P= 0;

  if Buff[0]='$' then
    E=16;
    P= 1;
  end

  while Buff[P]!=#0 do
    word S=0;
    while TRUE do
      if Digit[S]=#0 then
        Stop(@emNUMBER);
      end

      if Digit[S]=Buff[P] then
        exit
      end

      inc S;
    end

    if S>=E then
      Stop(@emNUMBER);
    end

    S=E*L+S;
    L=S%256;
    S=E*H+S/256;
    H=S%256;
    S=S/256;

    if S>0 then
      Stop(@emOVERFLOW);
    end

    inc P;
  end

  return 256*H+L;
end

long Seek(long P)
  if IP-P.Low>pDest then
    Stop(@emNOMEMORY);
  end

  pPred=pDest;
  pDest=pDest-(IP-P.Low); //P.Low
  fDest=1;
end

long Back()
  if fDest=1 then
    pDest=pPred;
    fDest=0;
  end
  long    L;
  L.Low =IP;
  return  L;
end

void Code(byte B)
  if pDest>=dbSIZE then
    Stop(@emNOMEMORY);
  end

  Dest[pDest]=B;
  inc  pDest;

  if fDest=0 then
    inc IP;
  end
end

void Jump(word L)
  Code($E9);
  Code(L%256);
  Code(L/256);
  Back();
end

char Read()
  if pChar>=nChar then
    nChar=read(F1,@Buff,sbSIZE);
    if nChar<1 then
      Stop(@emEOF);
    end
    pChar=0;
  end
  return Buff[pChar];
end

void Next()
  inc pChar;
end

char @Scan(char @Buff)
  word N=0;
  char Ch;
  while TRUE do
    while TRUE do
      Ch=Read();
      if Ch=#32 then
        Next();
        loop
      end

      if Ch=#09 then
        Next();
        loop
      end

      if Ch=#13 then
        Next();
        loop
      end

      if Ch=#10 then
        inc Line;
        if Line%100=0 then
          Info();
        end

        Next();
        loop
      end

      exit
    end

    if Ch='/' then
      Next();
      if Read()='*' then
        Next();
        inc N;
      end

      if N>0 then
        loop
      end

      if Read()='/' then
        while Read()!=#10 do
          Next();
        end
        loop
      end

      return @strcpy(@Buff,"/");
    end

    if N=0 then
      exit
    end

    if Ch='*' then
      Next();
      if Read()='/' then
        Next();
        dec N;
      end
      loop
    end

    Next();
  end

  word P=0;
  while TRUE do
    if P>=idSIZE then
      Stop(@emSIZE);
    end
    if isalpha(Ch)!=0 then
      if isdigit(Ch)!=0 then
        exit
      end
    end

    Buff[P]=Ch;
    inc  P;

    Next();
    Ch=Read();
  end

  if P>0 then
    Buff[P]=#0;
    return @Buff;
  end

  if Ch='!' then
    Next();
    if Read()='=' then
      Next();
      return @strcpy(@Buff,"!=");
    end
    return @strcpy(@Buff,"!");
  end

  if Ch='<' then
    Next();
    if Read()='=' then
      Next();
      return @strcpy(@Buff,"<=");
    end
    return @strcpy(@Buff,"<");
  end

  if Ch='>' then
    Next();
    if Read()='=' then
      Next();
      return @strcpy(@Buff,">=");
    end
    return @strcpy(@Buff,">");
  end

  if Ch=':' then
    Next();
    if Read()='=' then
      Next();
      return @strcpy(@Buff,":=");
    end
    return @strcpy(@Buff,":");
  end

  Next();

  Buff[0]=Ch;
  Buff[1]=#0;

  return  @Buff;
end

define  HASH 23173

word FindGlb(char @Name; word pGroup, pIndex)
  word  H=0;
  word  I=0;
  while Name[I]!=#0 do
    H=HASH*H+CharToWord(Name[I]);
    inc I;
  end

  H=HASH*H%gtSIZE;

  while TRUE do
    if GTabl[H]=0 then
      if pGroup!=0 then
        GTabl [H]=pGroup|pIndex;
      end

      return H;
    end

    char @P;
    select
      case (GTabl[H] & gtWORD)!=0:
        @P=@WTabl[GTabl[H] & gtIDX];

      case (GTabl[H] & gtDEF) !=0:
        @P=@CTabl[GTabl[H] & gtIDX].Name;

      case (GTabl[H] & gtTYPE)!=0:
        @P=@TTabl[GTabl[H] & gtIDX].Name;

      case (GTabl[H] & gtDATA)!=0:
        @P=@DTabl[GTabl[H] & gtIDX].Name;

      case (GTabl[H] & gtSUB) !=0:
        @P=@STabl[GTabl[H] & gtIDX].Name;

      case (GTabl[H] & gtPARM)!=0:
        @P=@PTabl[GTabl[H] & gtIDX].Name;

      case (GTabl[H] & gtVAR) !=0:
        @P=@VTabl[GTabl[H] & gtIDX].Name;

      default:
        Stop(@emINTERNAL);
    end

    if strcmp(@P,@Name)=0 then
      if pGroup!=0 then
        Stop(@emDOUBLE);
      end

      return H;
    end

    inc H;
    if  H>=gtSIZE then
      H=0;
    end
  end
end

word FindConst(char @Name)
  word P=GTabl[FindGlb(@Name,0,0)];

  if (P & gtDEF)=0 then
    return nConst;
  end

  return P & gtIDX;
end

word FindType(char @Name)
  word P=GTabl[FindGlb(@Name,0,0)];

  if (P & gtTYPE)=0 then
    return nType;
  end

  return P & gtIDX;
end

void Init()
  word   K=0;
  while  K<=rgES do
    Regs[K]=0;
    inc  K;
  end
  SP=0;
end

void Push(word R)
  if Regs[R]!=0 then
    select
      case R=rgAX:
        Code($50);
      case R=rgDX:
        Code($52);
      case R=rgDI:
        Code($57);
      case R=rgES:
        Code($06);
      default:
        Stop(@emINTERNAL);
    end

    if SP>=ssSIZE then
      Stop(@emNOMEMORY);
    end

    Stack[SP]=R;
    inc   SP;

    Regs[R]=0;
  end
end

void Pop (word R)
  while Regs[R]=0 do
    if SP<1 then
      Stop(@emINTERNAL);
    end

    dec SP;

    if Regs[Stack[SP]]!=0 then
      Stop(@emINTERNAL);
    end

    select
      case Stack[SP]=rgAX:
        Code($58);
      case Stack[SP]=rgDX:
        Code($5A);
      case Stack[SP]=rgDI:
        Code($5F);
      case Stack[SP]=rgES:
        Code($07);
      default:
        Stop(@emINTERNAL);
    end

    Regs[Stack[SP]]=1;
  end
end

void LDAX(OpInfo @Op1)
  char Buff [128];

  if Op1.Value=0 then
    select
      case Op1.Seg=srNO:
        Push(rgDX);
        Push(rgAX);
        Code($33);
        Code($D2);
        Code($33);
        Code($C0);

      case Op1.Seg=srAX:
        Pop (rgDX);
        Pop (rgAX);

      case Op1.Seg=srCS:
        Push(rgDX);
        Push(rgAX);
        if nLoad>=ltSIZE then
          Stop(@emNOMEMORY);
        end

      //LTabl[nLoad].IP    =Back();
        LTabl[nLoad].IP.Low=Back().Low+1;
        LTabl[nLoad].Ofs   =Op1.Ofs;
        inc   nLoad;

        Code($B8);
        Code($00);
        Code($00);
        Code($8C);
        Code($CA);

      case Op1.Seg=srDS:
        if Op1.Index!=0 then
          Pop (rgDI);
          Push(rgDX);
          Push(rgAX);
          Code($B8);
          Code(Op1.Ofs%256);
          Code(Op1.Ofs/256);
          Code($03);
          Code($C7);
          Code($8C);
          Code($DA);
          Regs[rgDI]=0;
        else
          Push(rgDX);
          Push(rgAX);
          Code($B8);
          Code(Op1.Ofs%256);
          Code(Op1.Ofs/256);
          Code($8C);
          Code($DA);
        end

      case Op1.Seg=srBP:
        if Op1.Index!=0 then
          Pop (rgDI);
          Push(rgDX);
          Push(rgAX);
          Code($B8);
          Code(Op1.Ofs%256);
          Code(Op1.Ofs/256);
          Code($03);
          Code($C5);
          Code($03);
          Code($C7);
          Code($8C);
          Code($D2);
          Regs[rgDI]=0;
        else
          Push(rgDX);
          Push(rgAX);
          Code($B8);
          Code(Op1.Ofs%256);
          Code(Op1.Ofs/256);
          Code($03);
          Code($C5);
          Code($8C);
          Code($D2);
        end

      case Op1.Seg=srBN:
        if Op1.Index!=0 then
          Pop (rgDI);
          Push(rgDX);
          Push(rgAX);
          Code($BA);
          Code(Op1.Ofs%256);
          Code(Op1.Ofs/256);
          Code($8B);
          Code($C5);
          Code($03);
          Code($C7);
          Code($2B);
          Code($C2);
          Code($8C);
          Code($D2);
          Regs[rgDI]=0;
        else
          Push(rgDX);
          Push(rgAX);
          Code($BA);
          Code(Op1.Ofs%256);
          Code(Op1.Ofs/256);
          Code($8B);
          Code($C5);
          Code($2B);
          Code($C2);
          Code($8C);
          Code($D2);
        end

      case Op1.Seg=srES:
        if Op1.Index!=0 then
          Pop (rgDI);
          Pop (rgES);
          Push(rgDX);
          Push(rgAX);

          if Op1.Ofs>0 then
            Code($BA);
            Code(Op1.Ofs%256);
            Code(Op1.Ofs/256);
            Code($03);
            Code($C7);
          else
            Code($8B);
            Code($C7);
          end

          Regs[rgDI]=0;
        else
          Stop(@emINTERNAL);
        end

        Code($8C);
        Code($C2);
        Regs[rgES]=0;

      default:
        Stop(@emINTERNAL);
    end

    Regs[rgDX]=1;
    Regs[rgAX]=1;

    return
  end

  word S=4;
  if Op1.nPtr=0 then
    if Op1.pType=ttVOID then
      Stop(@emVOID);
    end

    S=TTabl[Op1.pType].Size;
  end

  if Op1.Seg=srNO then
    select
      case S=1:
        Push(rgAX);
        Code($B0);
        Code(Op1.Ofs%256);

      case S=2:
        Push(rgAX);
        Code($B8);
        Code(Op1.Ofs%256);
        Code(Op1.Ofs/256);

      default:
        Stop(@emINTERNAL);
    end

    Regs[rgAX]=1;

    return
  end

  if Op1.Seg=srAX then
    select
      case S=1:
        select
          case Op1.High=1:
            Pop (rgAX);
          case Op1.High=2:
            Pop (rgAX);
          case Op1.High=4:
            Pop (rgDX);
            Pop (rgAX);
            Regs[rgDX]=0;
          default:
            Stop(@emINTERNAL);
        end

        select
          case Op1.Ofs=0:
          //null
          case Op1.Ofs=1:
            Code($8A);
            Code($C4);
          case Op1.Ofs=2:
            Code($8A);
            Code($C2);
          case Op1.Ofs=3:
            Code($8A);
            Code($C6);
          default:
            Stop(@emINTERNAL);
        end

      case S=2:
        select
          case Op1.High=2:
            Pop (rgAX);
          case Op1.High=4:
            Pop (rgDX);
            Pop (rgAX);
            Regs[rgDX]=0;
          default:
            Stop(@emINTERNAL);
        end

        select
          case Op1.Ofs=0:
          //null
          case Op1.Ofs=1:
            Code($8A);
            Code($C4);
            Code($8A);
            Code($E2);
          case Op1.Ofs=2:
            Code($8B);
            Code($C2);
          default:
            Stop(@emINTERNAL);
        end

      case S=4:
        if Op1.High!=4 then
          Stop(@emINTERNAL);
        end

        if Op1.Ofs!=0 then
          Stop(@emINTERNAL);
        end

        Pop (rgDX);
        Pop (rgAX);

        Regs[rgDX]=1;

      default:
        Stop(@emINTERNAL);
    end

    Regs[rgAX]=1;

    return
  end

  word Ofs=Op1.Ofs;
  word C0;
  word C1;
  word C2;

  select
    case Op1.Seg=srDS:
      if Op1.Index!=0 then
        Pop   (rgDI);
        C1=$85;
        C2=$05;
        Regs  [rgDI]=0;
      else
        C1=$06;
        C2=$06;
      end

    case Op1.Seg=srBP:
      if Op1.Index!=0 then
        Pop   (rgDI);
        C1=$83;
        C2=$03;
        Regs  [rgDI]=0;
      else
        C1=$86;
        C2=$86;
      end

    case Op1.Seg=srBN:
      if Op1.Index!=0 then
        Pop   (rgDI);
        Ofs=($FFFF-Ofs)+1;
        C1 = $83;
        C2 = $03;
        Regs  [rgDI]=0;
      else
        Ofs=($FFFF-Ofs)+1;
        C1 = $86;
        C2 = $86;
      end

    case Op1.Seg=srES:
      if Op1.Index!=0 then
        Pop   (rgDI);
        Pop   (rgES);
        C1=$85;
        C2=$05;
        Regs  [rgDI]=0;
        Regs  [rgES]=0;
      else
        Stop(@emINTERNAL);
      end
  end

  select
    case S=1:
      Push(rgAX);
      C0=$8A;
      Regs[rgAX]=1;

    case S=2:
      Push(rgAX);
      C0=$8B;
      Regs[rgAX]=1;

    case S=4:
      C0=$8B;

      Regs[rgDX]=1;
      Regs[rgAX]=1;

    default:
      Stop(@emINTERNAL);
  end

  if Op1.Seg=srES then
    Code($26);
  end

  Code(C0);
  if Ofs!=0 | Op1.Index=0 | Op1.Seg=srBP | Op1.Seg=srBN then
    Code(C1);
    Code(Ofs%256);
    Code(Ofs/256);
  else
    Code(C2);
  end

  if S=4 then
    if Op1.Seg=srES then
      Code($26);
    end

    Ofs =Ofs+2;
    word D=$10;
    Code(C0);
    Code(C1|D);
    Code(Ofs%256);
    Code(Ofs/256);
  end
end

void LDBX(OpInfo @Op1)
  word S=4;
  if Op1.nPtr=0 then
    if Op1.pType=ttVOID then
      Stop(@emVOID);
    end
    S=TTabl[Op1.pType].Size;
  end

  char Buff [128];

  if Op1.Seg=srNO then
    select
      case S=1:
        Code($B3);
        Code(Op1.Ofs%256);

      case S=2:
        Code($BB);
        Code(Op1.Ofs%256);
        Code(Op1.Ofs/256);

      default:
        Stop(@emINTERNAL);
    end

    return
  end

  if Op1.Seg=srAX then
    select
      case S=1:
        Pop (rgAX);
        Code($8A);
        Code($D8);
        Regs[rgAX]=0;

      case S=2:
        Pop (rgAX);
        Code($8B);
        Code($D8);
        Regs[rgAX]=0;

      case S=4:
        Pop (rgDX);
        Pop (rgAX);
        Code($8B);
        Code($D8);
        Code($8B);
        Code($CA);
        Regs[rgAX]=0;
        Regs[rgDX]=0;

      default:
        Stop(@emINTERNAL);
    end

    return
  end

  word Ofs=Op1.Ofs;
  word C0;
  word C1;
  word C2;

  select
    case Op1.Seg=srDS:
      if Op1.Index!=0 then
        Pop   (rgDI);
        C1=$9D;
        C2=$1D;
        Regs  [rgDI]=0;
      else
        C1=$1E;
        C2=$1E;
      end

    case Op1.Seg=srBP:
      if Op1.Index!=0 then
        Pop   (rgDI);
        C1=$9B;
        C2=$1B;
        Regs  [rgDI]=0;
      else
        C1=$9E;
        C2=$9E;
      end

    case Op1.Seg=srBN:
      if Op1.Index!=0 then
        Pop   (rgDI);
        Ofs=($FFFF-Ofs)+1;
        C1=$9B;
        C2=$1B;
        Regs  [rgDI]=0;
      else
        Ofs=($FFFF-Ofs)+1;
        C1 = $9E;
        C2 = $9E;
      end

    case Op1.Seg=srES:
      if Op1.Index!=0 then
        Pop   (rgDI);
        Pop   (rgES);
        C1=$9D;
        C2=$1D;
        Regs  [rgDI]=0;
        Regs  [rgES]=0;
      else
        Stop(@emINTERNAL);
      end
  end

  select
    case S=1:
      C0=$8A;

    case S=2:
      C0=$8B;

    case S=4:
      C0=$8B;

    default:
      Stop(@emINTERNAL);
  end

  if Op1.Seg=srES then
    Code($26);
  end

  Code(C0);
  word D=$10;
  if Ofs!=0 | Op1.Index=0 | Op1.Seg=srBP | Op1.Seg=srBN then
    Code(C1|D);
    Code(Ofs%256);
    Code(Ofs/256);
  else
    Code(C2|D);
  end

  if S=4 then
    if Op1.Seg=srES then
      Code($26);
    end

    Ofs =Ofs+2;
    Code(C0);
    Code(C1);
    Code(Ofs%256);
    Code(Ofs/256);
  end
end

void LPTR(OpInfo @Op1)
  char Buff [128];

  word Ofs=Op1.Ofs;
  word C1 =$C4;
  word C2;

  select
    case Op1.Seg=srAX:
      Pop (rgAX);
      Pop (rgDX);
      Push(rgES);
      Push(rgDI);

      Code($8E);
      Code($C2);
      Code($8B);
      Code($F8);

      Regs[rgAX]=0;
      Regs[rgDX]=0;

    case Op1.Seg=srDS:
      if Op1.Index!=0 then
        Pop   (rgDI);
        Push  (rgES);
        C2=$BD;
      else
        Push  (rgES);
        Push  (rgDI);
        C2=$3E;
      end

    case Op1.Seg=srBP:
      if Op1.Index!=0 then
        Pop   (rgDI);
        Push  (rgES);
        C2=$BB;
      else
        Push  (rgES);
        Push  (rgDI);
        C2=$BE;
      end

    case Op1.Seg=srBN:
      if Op1.Index!=0 then
        Pop   (rgDI);
        Push  (rgES);
        Ofs=($FFFF-Ofs)+1;
        C2 = $BB;
      else
        Push  (rgES);
        Push  (rgDI);
        Ofs=($FFFF-Ofs)+1;
        C2 = $BE;
      end

    case Op1.Seg=srES:
      if Op1.Index!=0 then
        Pop   (rgDI);
        Pop   (rgES);
        Code($26);
        C2 = $BD;
      else
        Stop(@emINTERNAL);
      end

    default:
      Stop(@emINTERNAL);
  end

  if Op1.Seg!=srAX then
    Code(C1);
    Code(C2);
    Code(Ofs%256);
    Code(Ofs/256);
  end

  Regs[rgDI]=1;
  Regs[rgES]=1;

  Op1.Seg   =srES;
  Op1.Index =1;
  Op1.Ofs   =0;
end

void STAX(OpInfo @Op1)
  if Op1.Value=0  then
    Stop(@emLVALUE);
  end

  if Op1.Seg=srNO then
    Stop(@emLVALUE);
  end

  word Ofs=Op1.Ofs;
  word C0;
  word C1;
  word C2;

  select
    case Op1.Seg=srDS:
      if Op1.Index!=0 then
        Pop   (rgDI);
        C1=$85;
        C2=$05;
      else
        C1=$06;
        C2=$06;
      end

    case Op1.Seg=srBP:
      if Op1.Index!=0 then
        Pop   (rgDI);
        C1=$83;
        C2=$03;
      else
        C1=$86;
        C2=$86;
      end

    case Op1.Seg=srBN:
      if Op1.Index!=0 then
        Pop   (rgDI);
        Ofs=($FFFF-Ofs)+1;
        C1 = $83;
        C2 = $03;
      else
        Ofs=($FFFF-Ofs)+1;
        C1 = $86;
        C2 = $86;
      end

    case Op1.Seg=srES:
      Pop   (rgDI);
      Pop   (rgES);
      C1=$85;
      C2=$05;

    default:
      Stop(@emINTERNAL);
  end

  word S=4;
  if Op1.nPtr=0 then
    S=TTabl[Op1.pType].Size;
  end

  select
    case S=1:
      C0=$88;

    case S=2:
      C0=$89;

    case S=4:
      C0=$89;

    default:
      Stop(@emINTERNAL);
  end

  if Op1.Seg=srES then
    Code($26);
  end

  Code(C0);
  if Ofs!=0 | Op1.Index=0 | Op1.Seg=srBP | Op1.Seg=srBN then
    Code(C1);
    Code(Ofs%256);
    Code(Ofs/256);
  else
    Code(C2);
  end

  if S=4 then
    if Op1.Seg=srES then
      Code($26);
    end

    Ofs =Ofs+2;
    word D=$10;
    Code(C0);
    Code(C1|D);
    Code(Ofs%256);
    Code(Ofs/256);
  end
end

word Comp(word Comp; word Jump)
  Code($32);
  Code($C9);

  Code(Comp);
  Code($C3);

  Code(Jump);
  Code($02);

  Code($B1);
  Code($01);
  Code($8A);
  Code($C1);

  return ttBOOL;
end

void Test(word pType1; word nPtr1; OpInfo @Op2)
  if nPtr1=0 then
    if Op2.nPtr!=0 then
      Stop(@emPOINTER);
    end

    if pType1=ttBYTE then
      if Op2.pType=ttWORD then
        Op2.pType=pType1;
      end
    end

    if pType1!=Op2.pType then
      Stop(@emTYPE);
    end
  else
    if Op2.nPtr=0 then
      Stop(@emNOPTR);
    end

    if pType1=0 then
      if nPtr1=1 | nPtr1=Op2.nPtr then
        return
      end
    end

    if Op2.pType=0 then
      if Op2.nPtr=1 | Op2.nPtr=nPtr1 then
        return
      end
    end

    if pType1!=Op2.pType then
      Stop(@emTYPE);
    end

    if nPtr1!=Op2.nPtr then
      Stop(@emEQUAL);
    end
  end
end

void Expr(word P; char @Buff; OpInfo @Op1)
  word Char=0;
  if Buff[1]=#0 then
    Char=HTabl[CharToWord(Buff[0])];
  end

  select
    case Char=$0400: // strcmp(@Buff,"(")=0
      if P>4 then
        Stop(@emNOBRACKET);
      end

      Expr(0,@Scan(@Buff),@Op1);
      if strcmp(@Buff,")")!=0 then
        Stop(@emCBRACKET);
      end

      Scan(@Buff);

    case Char=$0300: // strcmp(@Buff,"'")=0
      Op1.pType=ttCHAR;
      Op1.Seg  =srNO;
      Op1.Ofs  =CharToWord(Read());
      Op1.nPtr =0;
      Op1.Index=0;
      Op1.Value=1;

      Next();
      if Read()!=#39 then
        Stop(@emCHAR);
      end
      Next();

      Scan(@Buff);

    case Char=$0200: // strcmp(@Buff,"#")=0
      word D=Val(@Scan(@Buff));
      if D>255 then
        Stop(@emOVERFLOW);
      end
      Op1.pType=ttCHAR;
      Op1.Seg  =srNO;
      Op1.Ofs  =D;
      Op1.nPtr =0;
      Op1.Index=0;
      Op1.Value=1;

      Scan(@Buff);

    case Char=$0100: // strchr(@Buff,#34)=0
      word P=nByte;
      while TRUE do
        if Read()=#13 then
          Stop(@emSTRING);
        end
        if Read()=#10 then
          Stop(@emSTRING);
        end
        if nByte>=cbSIZE then
          Stop(@emNOMEMORY);
        end
        if Read()=#34 then
          Next();
          exit
        end
        CBuff[nByte]=Read();
        Next ();
        inc nByte;
      end

      CBuff[nByte]=#0;
      inc   nByte;

      Op1.pType=ttCHAR;
      Op1.Seg  =srCS;
      Op1.Ofs  =P;
      Op1.nPtr =1;
      Op1.Index=0;
      Op1.Value=0;

      Scan(@Buff);

    case isdigit(Buff[0])=0:
      word D=Val(@Buff);
      Op1.pType=ttWORD;
      Op1.Seg  =srNO;
      Op1.Ofs  =D;
      Op1.nPtr =0;
      Op1.Index=0;
      Op1.Value=1;

      Scan(@Buff);

    default:
      word pIndex;
      word nIndex;
      word nPtr;
      word N;
      word Call;

      N=0;
      while strcmp(@Buff,"@")=0 do
        Scan(@Buff);
        inc N;
      end

      Call=0;

      word F=GTabl[FindGlb(@Buff,0,0)];
      word I=F & gtIDX;

      select
        case (F & gtVAR)!=0:
          Op1.pType=VTabl[I].pType;
          Op1.Seg  =srBN;
          Op1.Ofs  =VTabl[I].Ofs;
          Op1.nPtr =N;
          Op1.Index=0;
          pIndex   =VTabl[I].pIndex;
          nIndex   =VTabl[I].nIndex;
          nPtr     =VTabl[I].nPtr;

        case (F & gtPARM)!=0:
          Op1.pType=PTabl[I].pType;
          Op1.Seg  =srBP;
          Op1.Ofs  =PTabl[I].Ofs;
          Op1.nPtr =N;
          Op1.Index=0;
          pIndex   =0;
          nIndex   =0;
          nPtr     =PTabl[I].nPtr;

        case (F & gtDATA)!=0:
          Op1.pType=DTabl[I].pType;
          Op1.Seg  =srDS;
          Op1.Ofs  =DTabl[I].Ofs;
          Op1.nPtr =N;
          Op1.Index=0;
          pIndex   =DTabl[I].pIndex;
          nIndex   =DTabl[I].nIndex;
          nPtr     =DTabl[I].nPtr;

        case (F & gtDEF)!=0:
          if CTabl[I].nPtr=0 then
            Op1.pType=CTabl[I].pType;
            Op1.Seg  =srNO;
            Op1.Ofs  =CTabl[I].Low;
            Op1.nPtr =N;
            Op1.Index=0;
            nPtr     =0;
          else
            Op1.pType=CTabl[I].pType;
            Op1.Seg  =srCS;
            Op1.Ofs  =CTabl[I].Low;
            Op1.nPtr =N;
            Op1.Index=0;
            nPtr     =0;

            if N=0 then
              Op1.nPtr=0;
              nPtr    =1;
            end
          end

          pIndex=0;
          nIndex=0;

        case (F & gtSUB)!=0:
          Push(rgES);
          Push(rgDI);
          Push(rgDX);
          Push(rgAX);

          word S=4;
          if STabl[I].nPtr=0 then
            S=TTabl[STabl[I].pType].Size;
          end
          if S%2>0 then
            inc S;
          end

          if S!=0 & S!=2 & S!=4 then
            Stop(@emNOTAVAIL);
          end

          if strcmp(@Scan(@Buff),"(")!=0 then
            Stop(@emCBRACKET);
          end

          Scan(@Buff);

          word K=STabl[I].pParm;
          while K<STabl[I].nParm do
            if K>STabl[I].pParm then
              if strcmp(@Buff,",")!=0 then
                Stop(@emCOMMA);
              end
              Scan(@Buff);
            end

            Expr(0,@Buff,@Op1);

            Test(PTabl[K].pType,PTabl[K].nPtr,@Op1);

            LDAX(@Op1);

            word S1=4;
            if PTabl[K].nPtr=0 then
              S1=TTabl[PTabl[K].pType].Size;
            end
            if S1%2>0 then
              inc S1;
            end

            select
              case S1=1:
                Code($50);
                Regs[rgAX]=0;
              case S1=2:
                Code($50);
                Regs[rgAX]=0;
              case S1=4:
                Code($52);
                Code($50);
                Regs[rgDX]=0;
                Regs[rgAX]=0;
              default:
                Stop(@emNOTAVAIL);
            end

            inc K;
          end

          if strcmp(@Buff,")")!=0 then
            Stop(@emCBRACKET);
          end

          word Ofs=STabl[I].Ofs-(IP+3);
          Code($E8);
          Code(Ofs%256);
          Code(Ofs/256);

          select
            case S=1:
              Regs[rgAX]=1;
            case S=2:
              Regs[rgAX]=1;
            case S=4:
              Regs[rgAX]=1;
              Regs[rgDX]=1;
          end

          Op1.pType=STabl[I].pType;
          Op1.Seg  =srAX;
          Op1.Ofs  =0;
          Op1.High =S;
          Op1.nPtr =N;
          Op1.Index=0;
          pIndex   =0;
          nIndex   =0;
          nPtr     =STabl[I].nPtr;

          if N=0 then
            Call   =1;
          end

        default:
          Stop(@emEXPECTED);
      end

      while TRUE do
        word P=pIndex;
        while pIndex<nIndex do
          if strcmp(@Scan(@Buff),"[")!=0 then
            if P<pIndex then
              Stop(@emSBRACKET);
            end
            exit
          end

          if pIndex!=P then
            Push(rgDX);
            Code($BA);
            Code(ITabl[pIndex]%256);
            Code(ITabl[pIndex]/256);
            Code($F7);
            Code($E2);
            Code($8B);
            Code($D0);
            Regs[rgDX]=1;
            Regs[rgAX]=0;
          end

          OpInfo Op2;
          Expr(0,@Scan(@Buff),@Op2);

          if strcmp(@Buff,"]")!=0 then
            Stop(@emSBRACKET);
          end

          LDAX(@Op2);

          if Op2.pType!=ttWORD then
            Stop(@emTYPE);
          end

          if Op2.nPtr>0 then
            Stop(@emPOINTER);
          end

          if pIndex!=P then
            Pop (rgDX);
            Code($03);
            Code($C2);
            Regs[rgDX]=0;
          end

          inc pIndex;
        end

        if P<nIndex then
          if pIndex<nIndex then
            if N<nPtr+1 then
              Stop(@emADDR);
            end
            exit
          end

          word S=4;
          if nPtr=0 then
            S=TTabl[Op1.pType].Size;
          end

          select
            case S=1:
            //null
            case S=2:
              Code($D1);
              Code($E0);
            case S=4:
              Code($D1);
              Code($E0);
              Code($D1);
              Code($E0);
            default:
              Push(rgDX);
              Code($BA);
              Code(S%256);
              Code(S/256);
              Code($F7);
              Code($E2);
          end

          if Op1.Index!=0 then
            Pop (rgDI);
            Code($03);
            Code($F8);
          else
            Push(rgDI);
            Code($8B);
            Code($F8);
            Op1.Index=1;
          end

          Regs[rgAX]=0;
          Regs[rgDI]=1;
        end

        while strcmp(@Scan(@Buff),"[")=0 do
          if nPtr<1 then
            exit
          end

          OpInfo Op2;
          Expr(0,@Scan(@Buff),@Op2);

          if strcmp(@Buff,"]")!=0 then
            Stop(@emSBRACKET);
          end

          word S=4;
          if nPtr<=1 then
            S=TTabl[Op1.pType].Size;
          end

          LDBX(@Op2);

          if Op2.pType!=ttWORD then
            Stop(@emTYPE);
          end

          if Op2.nPtr>0 then
            Stop(@emPOINTER);
          end

          select
            case S=1:
            //null
            case S=2:
              Code($D1);
              Code($E3);
            case S=4:
              Code($D1);
              Code($E3);
              Code($D1);
              Code($E3);
            default:
              Push(rgDX);
              Push(rgAX);
              Code($B8);
              Code(S%256);
              Code(S/256);
              Code($F7);
              Code($E3);
              Code($8B);
              Code($D8);
          end

          LPTR(@Op1);

          Code($03);
          Code($FB);

          Call=0;

          dec nPtr;
        end

        if strcmp(@Buff,".")!=0 then
          exit
        end

        while nPtr>0 do
          LPTR(@Op1);
          dec nPtr;
        end

        Scan(@Buff);

        P=TTabl[Op1.pType].pField;
        while TRUE do
          if P>=TTabl[Op1.pType].nField then
            Stop(@emFIELD);
          end
          if strcmp(@Buff,@FTabl[P].Name)=0 then
            exit
          end
          inc P;
        end

        if Op1.Seg!=srBN then
          Op1.Ofs=Op1.Ofs+FTabl[P].Ofs;
        else
          Op1.Ofs=Op1.Ofs-FTabl[P].Ofs;
        end
        Op1.pType=FTabl[P].pType;
        pIndex   =FTabl[P].pIndex;
        nIndex   =FTabl[P].nIndex;
        nPtr     =FTabl[P].nPtr;

        Call     =0;
      end

      if P>5 & strcmp(@Buff,";")=0 then
        if Call=0 then
          Stop(@emASSIGN);
        end
        return
      end

      if N>nPtr then
        dec N;
        if N>nPtr then
          Stop(@emADDR);
        end
        Op1.Value=0;
      else
        Op1.Value=1;
      end

      while nPtr>N do
        LPTR(@Op1);
        dec nPtr;
      end
  end

  while TRUE do
    word H;
    if Buff[1]!=#0 then
      if Buff[2]!=#0 then
        return
      end

      if Buff[1]!='=' then
        return
      end

      H=CharToWord(Buff[0])+256;
    else
      H=CharToWord(Buff[0]);
    end

    word Sign=HTabl[H];
    word P2  =Sign & $00FF;

    if P>=P2 then
      return
    end

    OpInfo Op2;
    Expr  (P2,@Scan(@Buff),@Op2);

    select
      case Op1.nPtr=0 & Op2.nPtr=0:
        if Op1.pType!=Op2.pType then
          Stop(@emTYPE);
        end

        LDBX(@Op2);
        LDAX(@Op1);

        select
          case Op1.pType=ttBOOL:
            select
              case Sign=$0101:
                Code($0A);
                Code($C3);

              case Sign=$0201:
                Code($32);
                Code($C3);

              case Sign=$0301:
                Code($22);
                Code($C3);

              default:
                Stop(@emUNDEFOPR);
            end

          case Op1.pType=ttCHAR:
            select
              case Sign=$0402:
                Op1.pType=Comp($3A,$73);

              case Sign=$0502:
                Op1.pType=Comp($3A,$77);

              case Sign=$0602:
                Op1.pType=Comp($3A,$75);

              case Sign=$0702:
                Op1.pType=Comp($3A,$74);

              case Sign=$0802:
                Op1.pType=Comp($3A,$72);

              case Sign=$0902:
                Op1.pType=Comp($3A,$76);

              default:
                Stop(@emUNDEFOPR);
            end

          case Op1.pType=ttWORD:
            select
              case Sign=$0101:
                Code($0B);
                Code($C3);

              case Sign=$0201:
                Code($33);
                Code($C3);

              case Sign=$0301:
                Code($23);
                Code($C3);

              case Sign=$0402:
                Op1.pType=Comp($3B,$73);

              case Sign=$0502:
                Op1.pType=Comp($3B,$77);

              case Sign=$0602:
                Op1.pType=Comp($3B,$75);

              case Sign=$0702:
                Op1.pType=Comp($3B,$74);

              case Sign=$0802:
                Op1.pType=Comp($3B,$72);

              case Sign=$0902:
                Op1.pType=Comp($3B,$76);

              case Sign=$0A03:
                Code($03);
                Code($C3);

              case Sign=$0B03:
                Code($2B);
                Code($C3);

              case Sign=$0C04:
                Push(rgDX);
                Code($F7);
                Code($E3);

              case Sign=$0D04:
                Push(rgDX);
                Code($33);
                Code($D2);
                Code($F7);
                Code($F3);

              case Sign=$0E04:
                Push(rgDX);
                Code($33);
                Code($D2);
                Code($F7);
                Code($F3);
                Code($8B);
                Code($C2);

              default:
                Stop(@emUNDEFOPR);
            end

          default:
            Stop(@emUNDEFOPR);
        end

        Op1.Seg  =srAX;
        Op1.Ofs  =0;
        Op1.High =TTabl[Op1.pType].Size;

      default:
        Stop(@emNOTAVAIL);
    end
  end
end

void Tabl(char @Buff; word @S)
  while strcmp(@Buff,"[")=0 do
    word D;
    word I=FindConst(@Scan(@Buff));
    if I<nConst then
      if CTabl[I].pType!=ttWORD then
        Stop(@emTYPE);
      end

      D=CTabl[I].Low;
    else
      D=Val(@Buff);
    end

    if D<1 then
      Stop(@emARRAY);
    end

    S=Mul(S,D);
    if S>Smax then
      Stop(@emSTRUCTURE);
    end

    if strcmp(@Scan(@Buff),"]")!=0 then
      Stop(@emSBRACKET);
    end

    if nIndex>=itSIZE then
      Stop(@emNOMEMORY);
    end

    ITabl[nIndex]=D;
    inc   nIndex;

    Scan(@Buff);
  end
end

word Retn;

void Ctrl(char @Buff)
  Retn=0;

  word J=GTabl[FindGlb(@Buff,0,0)];
  if (J & gtWORD)!=0 then
    J=J & gtIDX;
    if J=idIF | J=idSELECT then // strcmp(@Buff,"if")=0 | strcmp(@Buff,"select")=0
      long JTabl [jtSIZE];
      word nJump =0;

      word VSize1 =VSize;
      word nVar1  =nVar;
      word nIndex1=nIndex;

      word Flag   =0;
      long P;

      char @Case;
      char @Then;
      char @Else;

      if J=idIF then // strcmp(@Buff,"if")=0
        @Case="elseif";
        @Then="then";
        @Else="else";

        strcpy(@Buff,@Case);
      else
        @Case="case";
        @Then=":";
        @Else="default";

        Scan(@Buff);
      end

      while strcmp(@Buff,"end")!=0 do
        if Flag!=0 then
          if nJump>=jtSIZE then
            Stop(@emNOMEMORY);
          end

          JTabl[nJump]=Back();
          inc   nJump;

          Jump(0);

          Seek(P);
          Jump(IP-(P.Low+3));

          Back();
        end

        nIndex=nIndex1;
        while nVar>nVar1 do
          dec nVar;
          GTabl[VTabl[nVar].pGlb]=VTabl[nVar].vGlb;
        end
        VSize =VSize1;

        if strcmp(@Buff,@Else)=0 then
          if strcmp(@Buff,"default")=0 then
            if strcmp(@Scan(@Buff),":")!=0 then
              Stop(@emCOLON);
            end
          end

          while strcmp(@Scan(@Buff),"end")!=0 do
            Ctrl(@Buff);
          end

          Flag=0;
          loop
        end

        if strcmp(@Buff,@Case)=0 then
          OpInfo Op1;

          Init();
          Expr(0,@Scan(@Buff),@Op1);

          if strcmp(@Buff,@Then)!=0 then
            if strcmp(@Then,":")!=0 then
              Stop(@emTHENEXP);
            else
              Stop(@emCOLON);
            end
          end

          if Op1.nPtr>0 then
            Stop(@emPOINTER);
          end

          if Op1.pType!=ttBOOL then
            Stop(@emBOOLEAN);
          end

          LDAX(@Op1);

          Code($0A);
          Code($C0);
          Code($75);
          Code($03);
          P=Back();
          Jump(0);

          while TRUE do
            Scan(@Buff);
            if strcmp(@Buff,@Case)=0 then
              exit
            end
            if strcmp(@Buff,@Else)=0 then
              exit
            end
            if strcmp(@Buff,"end")=0 then
              exit
            end
            Ctrl(@Buff);
          end

          Flag=1;
          loop
        end

        Stop(@emUNDEFINED);
      end

      while nJump>0 do
        dec nJump;
        Seek(JTabl[nJump]);
        Jump(IP-(JTabl[nJump].Low+3));
      end

      if Flag!=0 then
        Seek(P);
        Jump(IP-(P.Low+3));
      end

      Back();

      nIndex=nIndex1;
      while nVar>nVar1 do
        dec nVar;
        GTabl[VTabl[nVar].pGlb]=VTabl[nVar].vGlb;
      end
      VSize =VSize1;

      return
    end

    if J=idWHILE | J=idDO then // strcmp(@Buff,"while")=0 | strcmp(@Buff,"do")=0
      word VSize1 =VSize;
      word nVar1  =nVar;
      word nIndex1=nIndex;
      word Loop1  =Loop;
      word nJump1 =nJump;

      Loop=IP;

      if J=idWHILE then // strcmp(@Buff,"do")!=0
        if strcmp(@Scan(@Buff),"TRUE")!=0 then
          OpInfo Op1;

          Init();
          Expr(0,@Buff,@Op1);

          if strcmp(@Buff,"do")!=0 then
            Stop(@emDOEXPECTED);
          end

          if Op1.nPtr>0 then
            Stop(@emPOINTER);
          end

          if Op1.pType!=ttBOOL then
            Stop(@emBOOLEAN);
          end

          LDAX(@Op1);

          Code($0A);
          Code($C0);
          Code($75);
          Code($03);

          if nJump>=jtSIZE then
            Stop(@emNOMEMORY);
          end

          JTabl[nJump]=Back();
          inc   nJump;

          Jump(0);

        else
          if strcmp(@Scan(@Buff),"do")!=0 then
            Stop(@emDOEXPECTED);
          end
        end
      end

      while strcmp(@Scan(@Buff),"end")!=0 do
        Ctrl(@Buff);
      end

      Jump(Loop-(IP+3));

      while nJump>nJump1 do
        dec nJump;
        Seek(JTabl[nJump]);
        Jump(IP-(JTabl[nJump].Low+3));
      end

      Back();

      Loop  =Loop1;
      nIndex=nIndex1;
      while nVar>nVar1 do
        dec nVar;
        GTabl[VTabl[nVar].pGlb]=VTabl[nVar].vGlb;
      end
      VSize =VSize1;

      return
    end

    if J=idLOOP then // strcmp(@Buff,"loop")=0
      if Loop=0 then
        Stop(@emLOOP);
      end

      Jump(Loop-(IP+3));

      return
    end

    if J=idEXIT then // strcmp(@Buff,"exit")=0
      if Loop=0 then
        Stop(@emLOOP);
      end

      if nJump>=jtSIZE then
        Stop(@emNOMEMORY);
      end

      JTabl[nJump]=Back();
      inc   nJump;

      Jump(0);

      return
    end

    if J=idINC then // strcmp(@Buff,"inc")=0
      OpInfo Op1;

      Init();
      Expr(5,@Scan(@Buff),@Op1);

      if Op1.nPtr>0 then
        Stop(@emPOINTER);
      end

      if strcmp(@Buff,";")!=0 then
        Stop(@emSEMICOLON);
      end

      LDAX(@Op1);

      if Op1.pType!=ttWORD then
        Stop(@emTYPE);
      end

      Code($40);

      Regs[rgDI]=1;
      Regs[rgES]=1;

      STAX(@Op1);

      return
    end

    if J=idDEC then // strcmp(@Buff,"dec")=0
      OpInfo Op1;

      Init();
      Expr(5,@Scan(@Buff),@Op1);

      if Op1.nPtr>0 then
        Stop(@emPOINTER);
      end

      if strcmp(@Buff,";")!=0 then
        Stop(@emSEMICOLON);
      end

      LDAX(@Op1);

      if Op1.pType!=ttWORD then
        Stop(@emTYPE);
      end

      Code($48);

      Regs[rgDI]=1;
      Regs[rgES]=1;

      STAX(@Op1);

      return
    end

    if J=idRETURN then // strcmp(@Buff,"return")=0
      if pSub<nSub then
        word S=4;
        if STabl[pSub].nPtr=0 then
          S=TTabl[STabl[pSub].pType].Size;
        end

        if S>0 then
          OpInfo Op1;

          Init();
          Expr(0,@Scan(@Buff),@Op1);

          if strcmp(@Buff,";")!=0 then
            Stop(@emSEMICOLON);
          end

          Test(STabl[pSub].pType,STabl[pSub].nPtr,@Op1);

          LDAX(@Op1);
        end

        Code($8B);
        Code($E5);

        Code($5D);

        Code($C2);
        Code(PSize%256);
        Code(PSize/256);
      else
        Code($B8);
        Code($00);
        Code($4C);

        Code($CD);
        Code($21);
      end

      Retn=1;

      return
    end

    if J=idASM then // strcmp(@Buff,"asm")=0
      if strcmp(@Scan(@Buff),"db")!=0 then
        Stop(@emDBEXP);
      end

      while TRUE do
        Scan(@Buff[1]);

        word  K=0;
        while Buff[K+1]!=#0 do
          inc K;
        end

        Buff[0]='0';
        if Buff[K]='H' then
          Buff[0]='$';
          Buff[K]=#0;
        end

        word C=Val(@Buff);
        if C>255 then
          Stop(@emNUMBER);
        end

        Code(C);

        while Read()=#09 | Read()=' ' do
          Next();
        end

        if Read()=#10 | Read()=#13 then
          exit
        end

        if strcmp(@Scan(@Buff),",")!=0 then
          Stop(@emCOMMA);
        end
      end

      return
    end

    if J=idNULL then
      return
    end

    Stop(@emINTERNAL);
  end

//word P=FindType(@Buff);
  if (J & gtTYPE)!=0 then // P<nType
    word P=J & gtIDX;
    while TRUE do
      word N=0;
      while strcmp(@Scan(@Buff),"@")=0 do
        inc N;
      end

      if isalpha(Buff[0])!=0 then
        Stop(@emEXPECTED);
      end

      if nVar>=vtSIZE then
        Stop(@emNOMEMORY);
      end

      word H=FindGlb(@Buff,0,0);
      if (GTabl[H] & gtWORD)!=0 then
        Stop(@emDOUBLE);
      end

      VTabl[nVar].pType =P;      strcpy(@VTabl[nVar].Name,@Buff);
      VTabl[nVar].pIndex=nIndex;
      VTabl[nVar].nIndex=0;
      VTabl[nVar].nPtr  =N;
      VTabl[nVar].pGlb  =H;
      VTabl[nVar].vGlb  =GTabl[H];

      GTabl[H]          =nVar|gtVAR;

      word S=4;
      if N=0 then
        S=TTabl[P].Size;
      end

      Tabl(@Scan(@Buff),@S);

      if S%2!=0 then
        inc S;
      end

      VSize=Add(VSize,S);
      if Add(VSize,Add(PSize,Add(RSize,4)))>Smax then
        Stop(@emSTRUCTURE);
      end

      if SSize<VSize then
        SSize=VSize;
      end

      VTabl[nVar].nIndex=nIndex;
      VTabl[nVar].Ofs   =VSize;

      if strcmp(@Buff,"=")=0 | strcmp(@Buff,":=")=0 then
        OpInfo Op1,Op2;

        if nIndex>VTabl[nVar].pIndex then
          Stop(@emNOTAVAIL);
        end

        Op1.pType=VTabl[nVar].pType;
        Op1.Seg  =srBN;
        Op1.Ofs  =VTabl[nVar].Ofs;
        Op1.nPtr =VTabl[nVar].nPtr;
        Op1.Index=0;
        Op1.Value=1;

        Init();
        Expr(0,@Scan(@Buff),@Op2);

        Test(Op1.pType,Op1.nPtr,@Op2);

        LDAX(@Op2);
        STAX(@Op1);
      end
      inc nVar;

      if strcmp(@Buff,";")=0 then
        exit
      end

      if strcmp(@Buff,",")!=0 then
        Stop(@emCOMMA);
      end
    end

    return
  end

  OpInfo Op1,Op2;

  Init();
  Expr(6,@Buff,@Op1);

  if strcmp(@Buff,";")=0 then
    return
  end

  if strcmp(@Buff,"=")!=0 & strcmp(@Buff,":=")!=0 then
    Stop(@emASSIGN);
  end

  Expr(0,@Scan(@Buff),@Op2);

  if strcmp(@Buff,";")!=0 then
    Stop(@emSEMICOLON);
  end

  Test(Op1.pType,Op1.nPtr,@Op2);

  LDAX(@Op2);
  STAX(@Op1);
end

void Type(char @Name; word Size)
  FindGlb(@Name,gtTYPE,nType);
  strcpy (@TTabl[nType].Name,  @Name);
  TTabl         [nType].pField=0;
  TTabl         [nType].nField=0;
  TTabl         [nType].Size  =Size;
  inc            nType;
end

void Word(char @Name; word ID)
  FindGlb(@Name,gtWORD,ID);
  @WTabl [ID]=@Name;
end

begin
  word @Size=@Ptr(GetPSP(),128); // byte
  char @Parm=@Ptr(GetPSP(),129);
  char  Buff [256];

  word  I=0;
  while I<Size%256 & Parm[I] =' ' do
    inc I;
  end

  word  P=0;
  word  N=0;
  word  K=0;
  while I<Size%256 & Parm[I]!=' ' do
    Buff[K]=Parm[I];
    select
      case Buff[K]='.':
        P=K;

      case Buff[K]='\':
        N=K+1;
        P=0;
    end

    inc  K;
    inc  I;
  end
  Buff[K]=#0;

  if K=0 then
    outs("Тpанслятоp языка Context. Веpсия 1.0");
    outs("(C) Хохлов А.В.  г. Москва 1995-2003");
    outs("Использование:  context  <имя файла>");
    return
  end

  if P=0 then
    P=K;
    strcpy(@Buff[P],".CTX");
  end

  if strlen(@Buff[N])>12 then
    puts(@Buff[N]);
    puts("(0): Слишком длинное имя файла");
    return
  end

  strcpy(@Name,@Buff[N]);

  F1=open(@Buff);
  if F1=$FFFF then
    puts(@Name);
    puts("(0): Невозможно откpыть файл");
    return
  end

  strcpy(@Buff[P],".COM");

  F2=create(@Buff);

  @Digit="0123456789ABCDEF";
  nGlb  =0;
  nType =0;
  nField=0;
  nSub  =0;
  nParm =0;
  DSize =0;
  nData =0;
  nConst=0;
  nLoad =0;
  nByte =0;
  nIndex=0;
  nJump =0;
  Loop  =0;

  Line  =1;

  nChar =0;
  pChar =0;

  pDest =0;
  fDest =0;

  IP    =0;

  Retn  =0;

  I=0;
  while   I<gtSIZE do
    GTabl[I]=0;
    inc   I;
  end

  I=0;
  while   I<512 do
    HTabl[I]=0;
    inc   I;
  end

  HTabl[ 34]=$0100; // "
  HTabl[ 35]=$0200; // #
  HTabl[ 39]=$0300; // '
  HTabl[ 40]=$0400; // (
  HTabl[124]=$0101; // |
  HTabl[ 94]=$0201; // ^
  HTabl[ 38]=$0301; // &
  HTabl[ 60]=$0402; // <
  HTabl[316]=$0502; // <=
  HTabl[ 61]=$0602; // =
  HTabl[289]=$0702; // !=
  HTabl[318]=$0802; // >=
  HTabl[ 62]=$0902; // >
  HTabl[ 43]=$0A03; // +
  HTabl[ 45]=$0B03; // -
  HTabl[ 42]=$0C04; // *
  HTabl[ 47]=$0D04; // /
  HTabl[ 37]=$0E04; // %

  Word("if",     idIF);
  Word("then",   idTHEN);
  Word("elseif", idELSEIF);
  Word("else",   idELSE);
  Word("select", idSELECT);
  Word("case",   idCASE);
  Word("default",idDEFAULT);
  Word("while",  idWHILE);
  Word("do",     idDO);
  Word("loop",   idLOOP);
  Word("exit",   idEXIT);
  Word("inc",    idINC);
  Word("dec",    idDEC);
  Word("return", idRETURN);
  Word("asm",    idASM);
  Word("null",   idNULL);
  Word("const",  idCONST);
  Word("define", idDEFINE);
  Word("struct", idSTRUCT);
  Word("begin",  idBEGIN);
  Word("end",    idEND);

  Type("void",0);
  Type("",    1);
  Type("char",1);
  Type("byte",1);
  Type("word",2);

  Code($B8);
  Code($00);
  Code($10);

  Code($8C);
  Code($CA);

  Code($03);
  Code($D0);

  Code($8E);
  Code($DA);

  Code($03);
  Code($D0);

  Code($8E);
  Code($D2);

/*JTabl[nJump]=Back();
  inc   nJump;*/

  LTabl[nLoad].IP.Low=Back().Low+1;
  LTabl[nLoad].Ofs   =0;
  inc   nLoad;

  Jump(0);

  word  Flag;
  while TRUE do // while strcmp(@Scan(@Buff),"begin")!=0 do
    I=GTabl[FindGlb(@Scan(@Buff),0,0)];

    if (I & gtWORD)!=0 then
      K=I & gtIDX;

      if K=idBEGIN then
        exit
      end

      if K=idCONST | K=idDEFINE then // strcmp(@Buff,"const")=0 | strcmp(@Buff,"define")=0
        Scan(@Buff);
        Flag=0;
        if strcmp(@Buff,"@")=0 then
          Scan(@Buff);
          Flag=1;
        end

        if isalpha(Buff[0])!=0 then
          Stop(@emEXPECTED);
        end

        FindGlb(@Buff,gtDEF,nConst);

        if nConst>=ctSIZE then
          Stop(@emNOMEMORY);
        end

        strcpy(@CTabl[nConst].Name,@Buff);

        Scan(@Buff);
        if Flag!=0 then
          if strchr(@Buff,#34)!=0 then
            Stop(@emSTRING);
          end
          CTabl[nConst].pType=ttCHAR;
          CTabl[nConst].nPtr =1;
          CTabl[nConst].Low  =nByte;

          while TRUE do
            if Read()=#13 then
              Stop(@emSTRING);
            end
            if Read()=#10 then
              Stop(@emSTRING);
            end
            if nByte>=cbSIZE then
              Stop(@emNOMEMORY);
            end
            if Read()=#34 then
              Next();
              exit
            end
            CBuff[nByte]=Read();
            Next ();
            inc nByte;
          end
          CBuff[nByte]=#0;
          inc   nByte;
        else
          if strcmp(@Buff,"'")=0 then
            CTabl[nConst].pType=ttCHAR;
            CTabl[nConst].nPtr =0;
            CTabl[nConst].Low  =CharToWord(Read());
            Next();
            if Read()!=#39 then
              Stop(@emCHAR);
            end
            Next();
          else
            if strcmp(@Buff,"#")=0 then
              word D=Val(@Scan(@Buff));
              if D>255 then
                Stop(@emOVERFLOW);
              end
              CTabl[nConst].pType=ttCHAR;
              CTabl[nConst].nPtr =0;
              CTabl[nConst].Low  =D;
            else
              word D=Val(@Buff);
              CTabl[nConst].pType=ttWORD;
              CTabl[nConst].nPtr =0;
              CTabl[nConst].Low  =D;
            end
          end
        end

        inc nConst;
        loop
      end

      if K=idSTRUCT then // strcmp(@Buff,"struct")=0
        Scan(@Buff);
        if isalpha(Buff[0])!=0 then
          Stop(@emEXPECTED);
        end

        FindGlb(@Buff,gtTYPE,nType);

        if nType>=ttSIZE then
          Stop(@emNOMEMORY);
        end

        strcpy(@TTabl[nType].Name,@Buff);
        P = nType;
        inc nType;

        word N1=nField;
        word S1=0;

        while TRUE do
          Scan(@Buff);

          if strcmp(@Buff,"end")=0 then
            if S1=0 then
              Stop(@emEMPTY);
            end
            TTabl[P].pField=N1;
            TTabl[P].nField=nField;
            TTabl[P].Size  =S1;
            exit
          end

          K=FindType(@Buff);
          if K<nType then
            while TRUE do
              N=0;
              while strcmp(@Scan(@Buff),"@")=0 do
                inc N;
              end

              if isalpha(Buff[0])!=0 then
                Stop(@emEXPECTED);
              end

              I=N1;
              while I<nField do
                if strcmp(@Buff,@FTabl[I].Name)=0 then
                  Stop(@emDOUBLE);
                end
                inc I;
              end

              if nField>=ftSIZE then
                Stop(@emNOMEMORY);
              end

              FTabl[nField].pType =K;      strcpy(@FTabl[nField].Name,@Buff);
              FTabl[nField].pIndex=nIndex;
              FTabl[nField].nIndex=0;
              FTabl[nField].nPtr  =N;
              FTabl[nField].Ofs   =S1;

              word S0=4;
              if N=0 then
                S0=TTabl[K].Size;
              end

              Tabl(@Scan(@Buff),@S0);

              S1=Add(S1,S0);
              if S1>Smax then
                Stop(@emSTRUCTURE);
              end

              FTabl[nField].nIndex=nIndex;
              inc   nField;

              if strcmp(@Buff,";")=0 then
                exit
              end

              if strcmp(@Buff,",")!=0 then
                Stop(@emCOMMA);
              end
            end

            loop
          end

          Stop(@emUNDEFINED);
        end

        loop
      end
    end

  //P=FindType(@Buff);
  //if P<nType then
    if (I & gtTYPE)!=0 then
      P   =I & gtIDX;
      Flag=1;
      while TRUE do
        N=0;
        while strcmp(@Scan(@Buff),"@")=0 do
          inc N;
        end

        if isalpha(Buff[0])!=0 then
          Stop(@emEXPECTED);
        end

        if nData>=dtSIZE then
          Stop(@emNOMEMORY);
        end

        DTabl[nData].pType =P;      strcpy(@DTabl[nData].Name,@Buff);
        DTabl[nData].pIndex=nIndex;
        DTabl[nData].nIndex=0;
        DTabl[nData].nPtr  =N;
        DTabl[nData].Ofs   =DSize;

      //if strcmp(@Buff,"(")=0 then
        if strcmp(@Scan(@Buff),"(")=0 then
          if Flag=0 then
            Stop(@emFUNCTION);
          end

          FindGlb(@DTabl[nData].Name,gtSUB,nSub);

          if nSub>=stSIZE then
            Stop(@emNOMEMORY);
          end

          STabl[nSub].pType=DTabl[nData].pType; strcpy(@STabl[nSub].Name,@DTabl[nData].Name);
          STabl[nSub].nPtr =DTabl[nData].nPtr;

          word N1=nParm;
          while TRUE do
            K=FindType(@Scan(@Buff));
            while K<nType do
              N=0;
              while strcmp(@Scan(@Buff),"@")=0 do
                inc N;
              end

              if isalpha(Buff[0])!=0 then
                Stop(@emEXPECTED);
              end

              if nParm>=ptSIZE then
                Stop(@emNOMEMORY);
              end

              word H=FindGlb(@Buff,0,0);
              if (GTabl[H] & gtWORD)!=0 then
                Stop(@emDOUBLE);
              end

              PTabl[nParm].pType=K; strcpy(@PTabl[nParm].Name,@Buff);
              PTabl[nParm].nPtr =N;
              PTabl[nParm].pGlb =H;
              PTabl[nParm].vGlb =GTabl[H];

              GTabl[H]          =nParm | gtPARM;

              inc   nParm;

              Scan(@Buff);
              if strcmp(@Buff,")")=0 then
                exit
              end
              if strcmp(@Buff,";")=0 then
                exit
              end
              if strcmp(@Buff,",")!=0 then
                Stop(@emCOMMA);
              end
            end
            if strcmp(@Buff,")")=0 then
              exit
            end
            if strcmp(@Buff,";")!=0 then
              Stop(@emSEMICOLON);
            end
          end

          STabl[nSub].pParm=N1;
          STabl[nSub].nParm=nParm;

          pSub =nSub;
          inc   nSub;

          RSize=4;
          if STabl[pSub].nPtr=0 then
            RSize=TTabl[STabl[pSub].pType].Size;
          end

          SSize=0;
          VSize=0;
          PSize=0;
          nVar =0;

          K=STabl[pSub].pParm;
          while K<STabl[pSub].nParm do
            word S=4;
            if PTabl[K].nPtr=0 then
              S=TTabl[PTabl[K].pType].Size;
            end
            if S%2>0 then
              inc S;
            end
            PSize=Add(PSize,S);
            if Add(PSize,Add(RSize,4))>Smax then
              Stop(@emSTRUCTURE);
            end
            PTabl[K].Ofs=PSize;
            inc   K;
          end

          K=STabl[pSub].pParm;
          while K<STabl[pSub].nParm do
            PTabl[K].Ofs=(PSize-PTabl[K].Ofs)+4;
            inc   K;
          end

          STabl[pSub].Ofs=IP;

          if pDest>=4096 then
            if write(F2,@Dest,pDest)!=pDest then
              Stop(@emWRITEERR);
            end

            pDest=0;
          end

          Code($55);

          Code($8B);
          Code($EC);

          long S=Back();
          Code($B8);
          Code($00);
          Code($00);

          Code($2B);
          Code($E0);

          while strcmp(@Scan(@Buff),"end")!=0 do
            Ctrl(@Buff);
          end

          Seek(S);
          Code($B8);
          Code(SSize%256);
          Code(SSize/256);

          while nVar>0 do
            dec nVar;
            GTabl[VTabl[nVar].pGlb]=VTabl[nVar].vGlb;
          end

          P=STabl[pSub].nParm;
          while P>STabl[pSub].pParm do
            dec P;
            GTabl[PTabl[P].pGlb]=PTabl[P].vGlb;
          end

          Back();
          if Retn=0 then
            Code($8B);
            Code($E5);

            Code($5D);

            Code($C2);
            Code(PSize%256);
            Code(PSize/256);
          end

          exit
        end

        FindGlb(@DTabl[nData].Name,gtDATA,nData);

        word S0=4;
        if N=0 then
          S0=TTabl[P].Size;
        end

        Tabl(@Buff,@S0);

        if S0%2!=0 then
          inc S0;
        end

        DSize=Add(DSize,S0);
        if DSize>Smax then
          Stop(@emSTRUCTURE);
        end

        DTabl[nData].nIndex=nIndex;
        inc   nData;

        if strcmp(@Buff,";")=0 then
          exit
        end

        if strcmp(@Buff,",")!=0 then
          Stop(@emCOMMA);
        end

        Flag=0;
      end

      loop
    end

    Stop(@emUNDEFINED);
  end

/*dec        nJump;
  Seek(JTabl[nJump]);
  Jump(IP-(JTabl[nJump].Low+3));*/

  LTabl[0].Ofs=IP-(LTabl[0].IP.Low+2);

  if pDest>=4096 then
    if write(F2,@Dest,pDest)!=pDest then
      Stop(@emWRITEERR);
    end

    pDest=0;
  end

  Code($55);

  Code($8B);
  Code($EC);

  long S=Back();
  Code($B8);
  Code($00);
  Code($00);

  Code($2B);
  Code($E0);

  pSub =nSub;
  RSize=0;
  PSize=0;
  SSize=0;
  VSize=0;
  nVar =0;
  while strcmp(@Scan(@Buff),"end")!=0 do
    Ctrl(@Buff);
  end

  Seek(S);
  Code($B8);
  Code(SSize%256);
  Code(SSize/256);

  Back();
  if Retn=0 then
    Code($8B);
    Code($E5);

    Code($5D);

    Code($B8);
    Code($00);
    Code($4C);

    Code($CD);
    Code($21);
  end

  word Ofs=Back().Low+$100;

  I=0;
  while  I<nByte do
    Code(CharToWord(CBuff[I]));
    inc  I;
  end

  if pDest>0 then
    if write(F2,@Dest,pDest)!=pDest then
      Stop(@emWRITEERR);
    end
  end

/*I=0;
  while  I<nLoad do
    word Ofs1=Ofs+LTabl[I].Ofs;
    Seek(LTabl[I].IP);
    Code($B8);
    Code(Ofs1%256);
    Code(Ofs1/256);
    Back();
    inc  I;
  end

  if pDest>0 then
    if write(F2,@Dest,pDest)!=pDest then
      Stop(@emWRITEERR);
    end
  end*/

  I=0;
  while I<nLoad do
    IP=LTabl[I].IP.Low;
    K =I;
    while I<nLoad do
      if (LTabl[I].IP.Low+1)-IP>=dbSIZE then
        exit
      end

      inc I;
    end

    seek (F2,IP);
    pDest=read(F2,@Dest,dbSIZE);

    while   K<I do
      word  Ofs1=LTabl[K].Ofs;
      if K>0 then
        Ofs1=Ofs1+Ofs;
      end

      Dest[(LTabl[K].IP.Low)  -IP]=Ofs1%256;
      Dest[(LTabl[K].IP.Low+1)-IP]=Ofs1/256;

      inc   K;
    end

    seek (F2,IP);
    write(F2,@Dest,pDest);
  end

  Info   ();

  close(F2);
  close(F1);
end
