program Pascal;

{$APPTYPE CONSOLE}

const
  MaxCode     = 65536;
  MaxIdent    = 512;
  MaxType     = 32;
  MaxList     = 10;
  MaxAlfa     = 20;
  MaxStrLen   = 255;
  MaxCase     = 256;
  MaxBinCode  = 262144;

  OPNone      = -1; OPAdd       = 0;  OPNeg       = 1;  OPMul       = 2;
  OPDivD      = 3;  OPRemD      = 4;  OPDiv2      = 5;  OPRem2      = 6;
  OPEqlI      = 7;  OPNEqI      = 8;  OPLssI      = 9;  OPLeqI      = 10;
  OPGtrI      = 11; OPGEqI      = 12; OPDupl      = 13; OPSwap      = 14;
  OPAndB      = 15; OPOrB       = 16; OPLoad      = 17; OPStore     = 18;
  OPHalt      = 19; OPWrI       = 20; OPWrC       = 21; OPWrL       = 22;
  OPRdI       = 23; OPRdC       = 24; OPRdL       = 25; OPEOF       = 26;
  OPEOL       = 27; OPLdC       = 28; OPLdA       = 29; OPLdLA      = 30;
  OPLdL       = 31; OPLdG       = 32; OPStL       = 33; OPStG       = 34;
  OPMove      = 35; OPCopy      = 36; OPAddC      = 37; OPMulC      = 38;
  OPJmp       = 39; OPJZ        = 40; OPCall      = 41; OPAdjS      = 42;
  OPExit      = 43;

  TokIdent    = 0;  TokNumber   = 1;  TokStrC     = 2;  TokPlus     = 3;
  TokMinus    = 4;  TokMul      = 5;  TokLBracket = 6;  TokRBracket = 7;
  TokColon    = 8;  TokEql      = 9;  TokNEq      = 10; TokLss      = 11;
  TokLEq      = 12; TokGtr      = 13; TokGEq      = 14; TokLParent  = 15;
  TokRParent  = 16; TokComma    = 17; TokSemi     = 18; TokPeriod   = 19;
  TokAssign   = 20; TokBEGIN    = 21; TokEND      = 22; TokIF       = 23;
  TokTHEN     = 24; TokELSE     = 25; TokWHILE    = 26; TokDO       = 27;
  TokCASE     = 28; TokREPEAT   = 29; TokUNTIL    = 30; TokFOR      = 31;
  TokTO       = 32; TokDOWNTO   = 33; TokNOT      = 34; TokDIV      = 35;
  TokMOD      = 36; TokAND      = 37; TokOR       = 38; TokCONST    = 39;
  TokVAR      = 40; TokTYPE     = 41; TokARRAY    = 42; TokOF       = 43;
  TokPACKED   = 44; TokRECORD   = 45; TokPROGRAM  = 46; TokFORWARD  = 47;
  TokHALT     = 48; TokFUNC     = 49; TokPROC     = 50; TokSymDiv   = 51;

  IdCONST     = 0;
  IdVAR       = 1;
  IdFIELD     = 2;
  IdTYPE      = 3;
  IdFUNC      = 4;

  KindSIMPLE  = 0;
  KindARRAY   = 1;
  KindRECORD  = 2;

  TypeINT     = 1;
  TypeBOOL    = 2;
  TypeCHAR    = 3;
  TypeSTR     = 4;

  FunCHR      = 0;
  FunORD      = 1;
  FunWRITE    = 2;
  FunWRITELN  = 3;
  FunREAD     = 4;
  FunREADLN   = 5;
  FunEOF      = 6;
  FunEOFLN    = 7;

type
  TAlfa = array [1..MaxAlfa] of char;

  TIdent=record
    name          :TAlfa;
    Link          :integer;
    TypeDef       :integer;
    Kind          :integer;
    Value         :integer;
    VLevel        :integer;
    VAdr          :integer;
    RefPar        :boolean;
    Offset        :integer;
    FLevel        :integer;
    FAdr          :integer;
    LastParameter :integer;
    ReturnAddress :integer;
    Inside        :boolean;
  end;

  TType=record
    Size          :integer;
    Kind          :integer;
    StartIndex    :integer;
    EndIndex      :integer;
    SubType       :integer;
    Fields        :integer;
  end;

var
  CurChar     :char;
  LinePos     :integer;
  LineNum     :integer;
  CurTok      :integer;
  CurID       :TAlfa;
  CurNum      :integer;
  CurStr      :array [1..MaxStrLen] of char;
  CurStrLen   :integer;
  FuncDecl    :integer;
  Keywords    :array [TokBEGIN..TokPROC] of TAlfa;
  LastOpcode  :integer;
  CurLevel    :integer;
  IsLabeled   :boolean;
  TokNameList :array [-1..MaxList] of integer;
  IdentPos    :integer;
  TypePos     :integer;
  IdentTab    :array [0..MaxIdent] of TIdent;
  TypeTab     :array [1..MaxType] of TType;
  Code        :array [0..MaxCode] of integer;
  CodePos     :integer;
  StackPos    :integer;

function StrCmp(var S1,S2:TAlfa):boolean;
var
  F:boolean;
  I:integer;
begin
  F:=true;
  I:=1;
  while F and (I<=MaxAlfa) do begin
    F:=(S1[I]=S2[I]);
    I:=I+1;
  end;
  StrCmp:=F;
end;

procedure StrCpy(var Dest:TAlfa; Src:TAlfa);
begin
  Dest:=Src;
end;

procedure Error(N:integer);
begin
  write('Error ',n:1,': ');
  case n of
    TokIdent:     write('identifier is expected');
    TokNumber:    write('number is expected');
    TokStrC:      write('string is expected');
    TokPlus:      write('+ is expected');
    TokMinus:     write('- is expected');
    TokMul:       write('* is expected');
    TokLBracket:  write('[ is expected');
    TokRBracket:  write('] is expected');
    TokColon:     write(': is expected');
    TokEql:       write('= is expected');
    TokNeq:       write('<> is expected');
    TokLss:       write('< is expected');
    TokLeq:       write('<= is expected');
    TokGtr:       write('> is expected');
    TokGeq:       write('>= is expected');
    TokLParent:   write('( is expected');
    TokRParent:   write(') is expected');
    TokComma:     write(', is expected');
    TokSemi:      write('; is expected');
    TokPeriod:    write('. is expected');
    TokAssign:    write(':= is expected');
    TokBEGIN:     write('BEGIN is expected');
    TokEND:       write('END is expected');
    TokIF:        write('IF is expected');
    TokTHEN:      write('THEN is expected');
    TokELSE:      write('ELSE is expected');
    TokWHILE:     write('WHILE is expected');
    TokDO:        write('DO is expected');
    TokCASE:      write('CASE is expected');
    TokREPEAT:    write('REPEAT is expected');
    TokUNTIL:     write('UNTIL is expected');
    TokFOR:       write('FOR is expected');
    TokTO:        write('TO is expected');
    TokDOWNTO:    write('DOWNTO is expected');
    TokNOT:       write('NOT is expected');
    TokDIV:       write('DIV is expected');
    TokMOD:       write('MOD is expected');
    TokAND:       write('AND is expected');
    TokOR:        write('OR is expected');
    TokCONST:     write('CONST is expected');
    TokVAR:       write('VAR is expected');
    TokTYPE:      write('TYPE is expected');
    TokARRAY:     write('ARRAY is expected');
    TokOF:        write('OF is expected');
    TokPACKED:    write('PACKED is expected');
    TokRECORD:    write('RECORD is expected');
    TokPROGRAM:   write('PROGRAM is expected');
    TokFORWARD:   write('FORWARD is expected');
    TokHALT:      write('HALT is expected');
    TokFUNC:      write('FUNCTION is expected');
    TokPROC:      write('PROCEDURE is expected');
    100:          write('String is not closed');
    101:          write('Empty string');
    102:          write('Bad char');
    103:          write('Too many identificators');
    104:          write('Identifier is already used');
    105:          write('Procedure is already defined');
    106:          write('Unknown identifier');
    107:          write('Invalid type');
    108:          write('Not a record');
    109:          write('No such field');
    110:          write('Not an array');
    111:          write('Can not write this type');
    112:          write('Can not read this type');
    113:          write('Too many arguments');
    114:          write('Passing string to var argument');
    115:          write('Passing string to not an array');
    116:          write('Passing string to array of not chars');
    117:          write('Passing string to array with mismatched size');
    118:          write('Too few arguments');
    119:          write('Using procedure in expression');
    120:          write('Using type in expression');
    121:          write('Expression expected');
    122:          write('Assigning to function');
    123:          write('Assigning to constant or type');
    124:          write('Case option should be constant');
    125:          write('Case option expected');
    126:          write('Colon expected');
    127:          write('Variable expected after FOR');
    128:          write('Iterator type is incorrect');
    129:          write('TO or DOWNTO expected');
    130:          write('Constant expected');
    131:          write('Identifier or number expected');
    132:          write('first index of array is bigger then last');
    133:          write('type expected');
    134:          write('Too many types');
    135:          write('Too many nested records');
    136:          write('Too many nested procedures');
    137:          write('Invalid return type of function');
    138:          write('More arguments then in forward declaration');
    139:          write('Argument name does not match forward declaration');
    140:          write('Argument type does not match forward declaration');
    141:          write('Argument var does not match forward declaration');
    142:          write('Less arguments then in forward declaration');
    143:          write('Already forward declared');
    144:          write('No definition for forward declared');
    901:          write('Negative stack size');
    902:          write('Binary is too big');
    903:          write('String is too long');
    906:          write('Too many case options');
    907:          write('Code is too long');
    909:          write('Can not compare this type');
  end;
  writeln(' at line ',LineNum:1,' at column ',LinePos:1);
  halt;
end;

{      }

procedure ReadChar;
begin
  if not EOF then begin
    read(CurChar);
    LinePos:=LinePos+1;
    if CurChar=CHR(10) then begin
      LineNum:=LineNum+1;
      LinePos:=0;
    end;
  end else begin
    CurChar:=CHR(0);
  end;
end;

{   }

function ReadNumber:integer;
var
  Num :integer;
begin
  Num:=0;
  if ('0'<=CurChar) and (CurChar<='9') then begin
    while ('0'<=CurChar) and (CurChar<='9') do begin
      Num:=(Num*10)+(ord(CurChar)-ord('0'));
      ReadChar;
    end;
    end else if CurChar='$' then begin
    ReadChar;
    while (('0'<=CurChar) and (CurChar<='9')) or
          (('A'<=CurChar) and (CurChar<='F')) or
          (('a'<=CurChar) and (CurChar<='f')) do begin

      if ('0'<=CurChar) and (CurChar<='9') then begin
        Num:=(Num*16)+(ord(CurChar)-ord('0'));
      end else if ('A'<=CurChar) and (CurChar<='F') then begin
        Num:=(Num*16)+(ord(CurChar)-ord('A')+10);
      end else if ('a'<=CurChar) and (CurChar<='f') then begin
        Num:=(Num*16)+(ord(CurChar)-ord('a')+10);
      end;

      ReadChar;
    end;
  end;
  ReadNumber:=Num;
end;

{   }

procedure GetToken;
var
  K,S           :integer;
  StrEnd,InStr  :boolean;
  LastChar      :char;
begin
  while (CurChar>CHR(0)) and (CurChar<=' ') do ReadChar;
  if (('a'<=CurChar) and (CurChar<='z')) or (('A'<=CurChar) and (CurChar<='Z')) then begin
    K:=0;
    while ((('a'<=CurChar) and (CurChar<='z')) or (('A'<=CurChar) and (CurChar<='Z')) or (('0'<=CurChar) and (CurChar<='9'))) or (CurChar='_') do begin
      if K<>MaxAlfa then begin
        K:=K+1;
        if ('a'<=CurChar) and (CurChar<='z') then CurChar:=CHR(ord(CurChar)-32);
        CurID[K]:=CurChar;
      end;
      ReadChar;
    end;
    while K<>MaxAlfa do begin
      K:=K+1;
      CurID[K]:=' ';
    end;
    CurTok:=TokIdent;
    S:=TokBEGIN;
    while S<=TokPROC do begin
      if StrCmp(Keywords[S],CurID) then CurTok:=S;
      S:=S+1;
    end;
  end else if (('0'<=CurChar) and (CurChar<='9')) or (CurChar='$') then begin
    CurTok:=TokNumber;
    CurNum:=ReadNumber;
  end else if CurChar=':' then begin
    ReadChar;
    if CurChar='=' then begin
      ReadChar;
      CurTok:=TokAssign;
    end else begin
      CurTok:=TokColon;
    end;
  end else if CurChar='>' then begin
    ReadChar;
    if CurChar='=' then begin
      ReadChar;
      CurTok:=TokGEq;
    end else begin
      CurTok:=TokGtr;
    end;
  end else if CurChar='<' then begin
    ReadChar;
    if CurChar='=' then begin
      ReadChar;
      CurTok:=TokLEq;
    end else if CurChar='>' then begin
      ReadChar;
      CurTok:=TokNEq;
    end else begin
      CurTok:=TokLss;
    end;
  end else if CurChar='.' then begin
    ReadChar;
    if CurChar='.' then begin
      ReadChar;
      CurTok:=TokColon;
    end else begin
      CurTok:=TokPeriod
    end;
  end else if (CurChar='''') or (CurChar='#') then begin
    CurStrLen:=0;
    StrEnd:=false;
    InStr:=false;
    CurTok:=TokStrC;
    while not StrEnd do begin
      if InStr then begin
        if CurChar='''' then begin
          ReadChar;
          if CurChar='''' then begin
            if CurStrLen=MaxStrLen then begin
              Error(903);
            end;
            CurStrLen:=CurStrLen+1;
            CurStr[CurStrLen]:=CurChar;
            ReadChar;
          end else begin
            InStr:=false;
          end;
        end else if (CurChar=CHR(13)) or (CurChar=CHR(10)) then begin
          Error(100);
          StrEnd:=true;
        end else begin
          if CurStrLen=MaxStrLen then begin
            Error(903);
          end;
          CurStrLen:=CurStrLen+1;
          CurStr[CurStrLen]:=CurChar;
          ReadChar;
        end;
      end else begin
        if CurChar='''' then begin
          InStr:=true;
          ReadChar;
        end else if CurChar='#' then begin
          ReadChar;
          if CurStrLen=MaxStrLen then begin
            Error(903);
          end;
          CurStrLen:=CurStrLen+1;
          CurStr[CurStrLen]:=chr(ReadNumber);
        end else begin
          StrEnd:=true;
        end;
      end;
    end;
    if CurStrLen=0 then begin
      Error(101);
    end;
  end else if CurChar='+' then begin
    ReadChar;
    CurTok:=TokPlus;
  end else if CurChar='-' then begin
    ReadChar;
    CurTok:=TokMinus;
  end else if CurChar='*' then begin
    ReadChar;
    CurTok:=TokMul;
  end else if CurChar='(' then begin
    ReadChar;
    if CurChar='*' then begin
      ReadChar;
      LastChar:='-';
      while not ((CurChar=')') and (LastChar='*')) do begin
        LastChar:=CurChar;
        ReadChar;
      end;
      ReadChar;
      GetToken;
    end else begin
      CurTok:=TokLParent;
    end;
  end else if CurChar='/' then begin //  
    ReadChar;
    if CurChar='/' then begin
      while not (CurChar=chr(10)) or (CurChar=chr(13)) do ReadChar;
      ReadChar;
      GetToken;
    end else begin
      CurTok:=TokSymDiv;
    end;
  end else if CurChar=')' then begin
    ReadChar;
    CurTok:=TokRParent;
  end else if CurChar='[' then begin
    ReadChar;
    CurTok:=TokLBracket;
  end else if CurChar=']' then begin
    ReadChar;
    CurTok:=TokRBracket;
  end else if CurChar='=' then begin
    ReadChar;
    CurTok:=TokEql;
  end else if CurChar=',' then begin
    ReadChar;
    CurTok:=TokComma;
  end else if CurChar=';' then begin
    ReadChar;
    CurTok:=TokSemi;
  end else if CurChar='{' then begin
    while CurChar<>'}' do ReadChar;
    ReadChar;
    GetToken;
  end else begin
    Error(102);
  end;
end;

procedure Check(S:integer);
begin
  if CurTok<>S then Error(S);
end;

procedure Expect(S:integer);
begin
  Check(S);
  GetToken;
end;

{     }

procedure EnterTokbol(CurID:TAlfa;K,T:integer);
var
  J:integer;
begin
  if IdentPos=MaxIdent then Error(103);
  IdentPos:=IdentPos+1;
  IdentTab[0].name:=CurID;
  J:=TokNameList[CurLevel];
  while not StrCmp(IdentTab[J].name,CurID) do J:=IdentTab[J].Link;
  if J<>0 then begin
    if IdentTab[J].Kind<>IdFUNC then Error(104);
    if (Code[IdentTab[J].FAdr]<>OPJmp) or (Code[IdentTab[J].FAdr+1]>0) then Error(105);
    IdentTab[J].name[1]:='$';
    Code[IdentTab[J].FAdr+1]:=CodePos;
    FuncDecl:=J;
  end;
  IdentTab[IdentPos].name:=CurID;
  IdentTab[IdentPos].Link:=TokNameList[CurLevel];
  IdentTab[IdentPos].TypeDef:=T;
  IdentTab[IdentPos].Kind:=K;
  TokNameList[CurLevel]:=IdentPos;
end;

{      }

function Position:integer;
var
  I,J:integer;
begin
  IdentTab[0].name:=CurID;
  I:=CurLevel;
  repeat
    J:=TokNameList[I];
    while not StrCmp(IdentTab[J].name,CurID) do J:=IdentTab[J].Link;
    I:=I-1;
  until (I<-1) or (J<>0);
  if J=0 then begin
    Error(106);
  end;
  Position:=J;
end;

{   - }

procedure AddCode(ACode:integer);
begin
  if CodePos<=MaxCode then begin
    Code[CodePos]:=ACode;
    CodePos:=CodePos+1;
  end else begin
    Error(907);
  end;
end;

procedure GenOp(Opcode,A:integer);
begin
  case Opcode of
    OPDupl,OPEOF,OPEOL,OPLdC,OPLdA,OPLdLA,OPLdL,OPLdG:    StackPos:=StackPos - 4;
    OPNeg,OPDiv2,OPRem2,OPSwap,OPLoad,OPHalt,OPWrL,
    OPRdL,OpAddC,OPMulC,OPJmp,OPCall,OPExit:              begin              end;
    OPAdd,OPMul,OPDivD,OPRemD,OPEqlI,OPNEqI,OPLssI,
    OPLeqI,OPGtrI,OPGEqI,OPAndB,OPOrB,OPWrC,OPRdI,
    OPRdC,OPStL,OPStG,OPJZ:                               StackPos:=StackPos + 4;
    OPStore,OPWrI,OPMove:                                 StackPos:=StackPos + 8;
    OPCopy:                                               StackPos:=StackPos - A + 4;
    OPAdjS:                                               StackPos:=StackPos + A;
  end;
  if not ((((Opcode=OPAddC) or (Opcode=OPAdjS)) and (A=0)) or ((Opcode=OPMulC) and (A=1))) then begin
    if IsLabeled then begin
      AddCode(Opcode);
      if Opcode>=OPLdC then AddCode(A);
      IsLabeled:=false;
    end else if (LastOpcode=OPLdC) and (Opcode=OPAdd) then begin
      Code[CodePos-2]:=OPAddC;
    end else if (LastOpcode=OPLdC) and (Opcode=OPMul) then begin
      Code[CodePos-2]:=OPMulC;
    end else if (LastOpcode=OPLdC) and (Opcode=OPNeg) then begin
      Code[CodePos-1]:=-Code[CodePos-1];
      Opcode:=LastOpcode;
    end else if (LastOpcode=OPLdC) and (Code[CodePos-1]=2) and (Opcode=OPDivD) then begin
      Code[CodePos-2]:=OPDiv2;
      CodePos:=CodePos-1;
    end else if (LastOpcode=OPLdC) and (Code[CodePos-1]=2) and (Opcode=OPRemD) then begin
      Code[CodePos-2]:=OPRem2;
      CodePos:=CodePos-1;
    end else if (LastOpcode=OPLdA) and (Opcode=OPStore) then begin
      Code[CodePos-2]:=OPStG;
    end else if (LastOpcode=OPLdA) and (Opcode=OPLoad) then begin
      Code[CodePos-2]:=OPLdG;
    end else if (LastOpcode=OPLdLA) and (Opcode=OPStore) then begin
      Code[CodePos-2]:=OPStL;
    end else if (LastOpcode=OPLdLA) and (Opcode=OPLoad) then begin
      Code[CodePos-2]:=OPLdL;
    end else begin
      AddCode(Opcode);
      if Opcode>=OPLdC then AddCode(A);
    end;
    LastOpcode:=Opcode;
  end;
end;

procedure GenOp2(Opcode:integer);
begin
  GenOp(Opcode,0);
end;

function CodeLabel:integer;
begin
  CodeLabel:=CodePos;
  IsLabeled:=true;
end;

procedure GenAddress(Level,Address:integer);
begin
  if Level=0 then begin
    GenOp(OPLdA,Address);
  end else if Level=CurLevel then begin
    GenOp(OPLdLA,Address-StackPos);
  end else begin
    GenOp(OPLdL,-StackPos);
    while Level+1<>CurLevel do begin
      GenOp2(OPLoad);
      Level:=Level+1;
    end;
    GenOp(OPAddC,Address);
  end;
end;

procedure GenAddressVar(IdentNr:integer);
begin
 GenAddress(IdentTab[IdentNr].VLevel,IdentTab[IdentNr].VAdr);
 if IdentTab[IdentNr].RefPar then GenOp2(OPLoad);
end;

procedure MustBe(X,Y:integer);
begin
  if X<>Y then
    if (TypeTab[X].Kind=KindARRAY) and (TypeTab[Y].Kind=KindARRAY)
    and (TypeTab[X].StartIndex=TypeTab[Y].StartIndex)
    and (TypeTab[X].EndIndex=TypeTab[Y].EndIndex) then
      MustBe(TypeTab[X].SubType,TypeTab[Y].SubType)
    else
      Error(107);
end;

{   }

procedure Expression(var X:integer); forward;

procedure Selector(var T,IdentNr:integer);
var
  J,X:integer;
begin
  T:=IdentTab[IdentNr].TypeDef;
  GetToken;
  if (CurTok=TokPeriod) or (CurTok=TokLBracket) then begin
    GenAddressVar(IdentNr);
    IdentNr:=0;
    while (CurTok=TokPeriod) or (CurTok=TokLBracket) do begin
      case CurTok of
        TokPeriod:
                  begin
                    if TypeTab[T].Kind<>KindRECORD then Error(108);   { .. }
                    GetToken;
                    Check(TokIdent);
                    J:=TypeTab[T].Fields;
                    IdentTab[0].name:=CurID;
                    while not StrCmp(IdentTab[J].name,CurID) do J:=IdentTab[J].Link;
                    if J=0 then Error(109);
                    GenOp(OPAddC,IdentTab[J].Offset);
                    T:=IdentTab[J].TypeDef;
                    GetToken;
                  end;
        TokLBracket:                                                  { [ }
                  begin
                    repeat
                      if TypeTab[T].Kind<>KindARRAY then Error(110);
                      GetToken;
                      Expression(X);
                      MustBe(TypeINT,X);
                      GenOp(OPAddC,-TypeTab[T].StartIndex);
                      T:=TypeTab[T].SubType;
                      GenOp(OPMulC,TypeTab[T].Size);
                      GenOp2(OPAdd);
                    until CurTok<>TokComma;
                    Expect(TokRBracket);
                  end;
      end;
    end;
  end;
end;

procedure VarPar(var T:integer);
var
  J:integer;
begin
  Check(TokIdent);
  J:=Position;
  Selector(T,J);
  if J<>0 then GenAddressVar(J);
end;

{    }

procedure InternalFunction(N:integer);
var
  X,code:integer;
begin
  case N of
    FunCHR:                                                           { CHR }
                begin
                  Expect(TokLParent);
                  Expression(X);
                  MustBe(TypeINT,X);
                  Expect(TokRParent)
                end;                                                  { ORD }
    FunORD:
                begin
                  Expect(TokLParent);
                  Expression(X);
                  if X<>TypeBOOL then MustBe(TypeCHAR,X);
                  Expect(TokRParent);
                end;
    FunWRITE,                                                         { WRITE }
    FunWRITELN:
                begin
                  if N=FunWRITE then Check(TokLParent);
                  if CurTok=TokLParent then begin
                    repeat
                      GetToken;
                      if CurTok=TokStrC then begin
                        X:=1;
                        while X<=CurStrLen do begin

                          code:=ord(CurStr[X]);
                          case code of
                            192..239: code:=code-64;
                            240..255: code:=code-16;
                          end;

                          GenOp(OPLdC,code);
                          GenOp2(OPWrC);
                          X:=X+1;
                        end;
                        GetToken;
                      end else begin
                        Expression(X);
                        if CurTok=TokColon then begin
                          MustBe(TypeINT,X);
                          GetToken;
                          Expression(X);
                          MustBe(TypeINT,X);
                          GenOp2(OPWrI);
                        end else if X=TypeINT then begin
                          GenOp(OPLdC,1);
                          GenOp2(OPWrI);
                        end else if X=TypeCHAR then begin
                          GenOp2(OPWrC);
                        end else begin
                          Error(111);
                        end;
                      end;
                    until CurTok<>TokComma;
                    Expect(TokRParent)
                  end;
                  if N=FunWRITELN then GenOp2(OPWrL);
                end;
    FunREAD,                                                          { READ }
    FunREADLN:
                begin
                  if N=FunREAD then Check(TokLParent);
                  if CurTok=TokLParent then begin
                    repeat
                      GetToken;
                      VarPar(X);
                      if X=TypeINT then begin
                        GenOp2(OPRdI);
                      end else if X=TypeCHAR then begin
                        GenOp2(OPRdC);
                      end else begin
                        Error(112);
                      end;
                    until CurTok<>TokComma;
                    Expect(TokRParent);
                  end;
                  if N=FunREADLN then GenOp2(OPRdL);
                end;
    FunEOF  :   GenOp2(OPEOF);
    FunEOFLN:   GenOp2(OPEOL);
  end;
end;

{    }

procedure FunctionCall(I:integer);
var
  OldStackPos,P,X:integer;
begin
  GetToken;
  if IdentTab[I].FLevel<0 then begin
    InternalFunction(IdentTab[I].FAdr);
  end else begin
    if IdentTab[I].TypeDef<>0 then GenOp(OPLdC,0);
    P:=I;
    OldStackPos:=StackPos;
    if CurTok=TokLParent then begin                                  { ( }
      repeat
        GetToken;
        if P=IdentTab[I].LastParameter then Error(113);
        P:=P+1;
        if IdentTab[P].RefPar then begin
          VarPar(X);
        end else begin
          Expression(X);
          if TypeTab[X].Kind<>KindSIMPLE then GenOp(OPCopy,TypeTab[X].Size);
        end;
        if X=TypeSTR then begin
          if IdentTab[P].RefPar then Error(114);
          if TypeTab[IdentTab[P].TypeDef].Kind<>KindARRAY then Error(115);
          if TypeTab[IdentTab[P].TypeDef].SubType<>TypeCHAR then Error(116);
          if ((TypeTab[IdentTab[P].TypeDef].EndIndex-TypeTab[IdentTab[P].TypeDef].StartIndex)+1)<>CurStrLen then Error(117);
        end else begin
          MustBe(IdentTab[P].TypeDef,X);
        end;
      until CurTok<>TokComma;
      Expect(TokRParent);
    end;
    if P<>IdentTab[I].LastParameter then Error(118);
    if IdentTab[I].FLevel<>0 then GenAddress(IdentTab[I].FLevel,0);
    GenOp(OPCall,IdentTab[I].FAdr);
    StackPos:=OldStackPos;
  end;
end;

{  ,     }

procedure Factor(var T:integer);
var
  I:integer;
begin
  if CurTok=TokIdent then begin
    I:=Position;
    T:=IdentTab[I].TypeDef;
    case IdentTab[I].Kind of
        IdCONST:                                                    { CONST }
                begin
                  GetToken;
                  GenOp(OPLdC,IdentTab[I].Value);
                end;
        IdVAR:                                                      { VAR }
                begin
                  Selector(T,I);
                  if I<>0 then GenAddressVar(I);
                  if TypeTab[T].Kind=KindSIMPLE then GenOp2(OPLoad);
                end;
        IdFUNC: if T=0 then Error(119) else FunctionCall(I);        { FUNC }
        IdTYPE: Error(120);                                         { TYPE }
    end;
  end else if CurTok=TokNumber then begin                           { NUMBER }
    GenOp(OPLdC,CurNum);
    T:=TypeINT;
    GetToken;
  end  else if CurTok=TokStrC then begin                            { STR }
    I:=CurStrLen;
    while I>=1 do begin
      GenOp(OPLdC,ord(CurStr[I]));
      I:=I-1;
    end;
    T:=TypeCHAR;
    if CurStrLen<>1 then T:=TypeSTR;
    GetToken;
  end else if CurTok=TokLParent then begin                          { ( }
    GetToken;
    Expression(T);
    Expect(TokRParent);
  end else if CurTok=TokNOT then begin                              { NOT }
    GetToken;
    Factor(T);
    MustBe(TypeBOOL,T);
    GenOp2(OPNeg);
    GenOp(OPAddC,1);
  end else begin
    Error(121);
  end;
end;

{    + - MOD AND }

procedure Term(var X:integer);
var
  Y:integer;
begin
  Factor(X);
  while (CurTok=TokAND) or (CurTok=TokMul) or (CurTok=TokDIV) or (CurTok=TokMOD) do begin
    if CurTok=TokAND then begin
      MustBe(TypeBOOL,X);
    end else begin
      MustBe(TypeINT,X);
    end;
    case CurTok of
        TokMul:                                                       { * }
                begin
                  GetToken;
                  Factor(Y);
                  GenOp2(OPMul);
                end;
        TokDIV:                                                       { DIV }
                begin
                  GetToken;
                  Factor(Y);
                  GenOp2(OPDivD);
                end;                                                  { MOD }
        TokMOD:
                begin
                  GetToken;
                  Factor(Y);
                  GenOp2(OPRemD);
                end;
        TokAND:                                                       { AND }
                begin
                  GetToken;
                  Factor(Y);
                  GenOp2(OPAndB);
                end;
    end;
    MustBe(X,Y);
  end;
end;

procedure SimpleExpression(var X:integer);
var
  Y:integer;
begin
  if CurTok=TokPlus then begin                                        { + }
    GetToken;
    Term(X);
    MustBe(TypeINT,X);
  end else if CurTok=TokMinus then begin                              { - }
    GetToken;
    Term(X);
    MustBe(TypeINT,X);
    GenOp2(OPNeg);
  end else begin
    Term(X);
  end;
  while (CurTok=TokOR) or (CurTok=TokPlus) or (CurTok=TokMinus) do begin
    if CurTok=TokOR then begin
      MustBe(TypeBOOL,X);
    end else begin
      MustBe(TypeINT,X);
    end;
    case CurTok of
        TokPlus:                                                      { + }
                begin
                  GetToken;
                  Term(Y);
                  GenOp2(OPAdd);
                end;
        TokMinus:                                                     { - }
                begin
                  GetToken;
                  Term(Y);
                  GenOp2(OPNeg);
                  GenOp2(OPAdd);
                end;
        TokOR:                                                        { OR }
                begin
                  GetToken;
                  Term(Y);
                  GenOp2(OPOrB);
                end;
    end;
    MustBe(X,Y);
  end;
end;

{    }

procedure Expression(var X:integer);
var
  O,Y:integer;
begin
  SimpleExpression(X);
  if (CurTok=TokEql) or (CurTok=TokNEq) or (CurTok=TokLss)
  or (CurTok=TokLEq) or (CurTok=TokGtr) or (CurTok=TokGEq) then begin
    if (X=TypeSTR) or (TypeTab[X].Kind<>KindSIMPLE) then Error(909);
    O:=CurTok;
    GetToken;
    SimpleExpression(Y);
    MustBe(X,Y);
    case O of                                                         {}
        TokEql: GenOp2(OPEqlI);                                       {}
        TokNEq: GenOp2(OPNEqI);                                       {}
        TokLss: GenOp2(OPLssI);                                       {}
        TokLEq: GenOp2(OPLeqI);                                       {}
        TokGtr: GenOp2(OPGtrI);                                       {}
        TokGEq: GenOp2(OPGEqI);                                       {}
    end;
    X:=TypeBOOL;
  end;
end;

{   ,   
     }

procedure Statement;
var
  L  :array [1..MaxCase] of integer;
  M,N,I,J,T,X,R,OldStackPos:integer;
begin
  if CurTok=TokIdent then begin
    I:=Position;

{ -------------------- VAR FUNC --------------------}

    case IdentTab[I].Kind of
        IdVAR:                                                        { VAR }
              begin
                Selector(T,I);
                Expect(TokAssign);
                Expression(X);
                MustBe(T,X);
                if I=0 then
                  GenOp2(OPSwap)
                else
                  GenAddressVar(I);
                if TypeTab[T].Kind=KindSIMPLE then
                  GenOp2(OPStore)
                else
                  GenOp(OPMove,TypeTab[T].Size);
              end;
        IdFUNC:                                                       { FUNC }
              begin
                if IdentTab[I].TypeDef=0 then
                  FunctionCall(I)
                else begin
                  if not IdentTab[I].Inside then Error(122);
                  GetToken;
                  Expect(TokAssign);
                  Expression(X);
                  MustBe(IdentTab[I].TypeDef,X);
                  GenAddress(IdentTab[I].FLevel+1,IdentTab[I].ReturnAddress);
                  GenOp2(OPStore);
                end;
              end;
        IdCONST,IdFIELD,IdTYPE: Error(123);
    end;

{ -------------------- IF THEN ELSE --------------------}

  end else if CurTok=TokIF then begin                                 { IF }
    GetToken;
    Expression(T);
    MustBe(TypeBOOL,T);
    Expect(TokTHEN);                                                  { THEN }
    I:=CodeLabel;
    GenOp(OPJZ,0);
    Statement;
    if CurTok=TokELSE then begin                                      { ELSE }
      GetToken;
      J:=CodeLabel;
      GenOp(OPJmp,0);
      Code[I+1]:=CodeLabel;
      I:=J;
      Statement;
    end;
    Code[I+1]:=CodeLabel;

{ -------------------- CASE --------------------}

  end else if CurTok=TokCASE then begin                               { CASE }
    GetToken;
    Expression(T);
    MustBe(TypeINT,T);                                          {   }
    Expect(TokOF);                                                    { OF }
    J:=0;
    M:=0;
    repeat
      if J<>0 then Code[J+1]:=CodeLabel;
      N:=M;
      repeat
        if N<>M then GetToken;
        GenOp2(OPDupl);
        if CurTok=TokIdent then begin                               // CONST
          I:=Position;
          if IdentTab[I].Kind<>IdCONST then Error(124);
          GenOp(OPLdC,IdentTab[I].Value);
        end else if CurTok=TokNumber then begin                     // NUMBER
          GenOp(OPLdC,CurNum);
        end else if (CurTok=TokStrC) and (CurStrLen=1) then begin   // CHAR
          GenOp(OPLdC,ord(CurStr[1]));
        end else begin
         Error(125);
        end;
        GenOp2(OPNEqI);
        if N=MaxCase then Error(906);
        N:=N+1;
        L[N]:=CodeLabel;
        GenOp(OPJZ,0);
        GetToken;
      until CurTok<>TokComma;                                         { , }
      if CurTok<>TokColon then Error(126);                            { : }
      J:=CodeLabel;
      GenOp(OPJmp,0);
      repeat
        Code[L[N]+1]:=CodeLabel;
        N:=N-1;
      until N=M;
      GetToken;
      Statement;
      M:=M+1;
      L[M]:=CodeLabel;
      GenOp(OPJmp,0);
      if CurTok=TokSemi then GetToken;                                { ; }
    until (CurTok=TokEND) or (CurTok=TokELSE);                        { END, ELSE }
    Code[J+1]:=CodeLabel;
    if CurTok=TokELSE then begin                                      { ELSE }
      GetToken;
      Statement;
      if CurTok=TokSemi then GetToken;                                { ; }
      Expect(TokEND);                                                 { END }
    end;
    repeat
      Code[L[M]+1]:=CodeLabel;
      M:=M-1;
    until M=0;
    GenOp(OPAdjS,4);
    GetToken;

{ -------------------- FOR  --------------------}

  end else if CurTok=TokFOR then begin                                { FOR }
    GetToken;
    if CurTok=TokIdent then begin
      OldStackPos:=StackPos;

      I:=Position;
      if IdentTab[I].Kind<>IdVAR then Error(127);
      Selector(T,I);
      Expect(TokAssign);
      Expression(X);
      MustBe(T,X);
      
      if I=0 then GenOp2(OPSwap) else GenAddressVar(I);
      if TypeTab[T].Kind<>KindSIMPLE then Error(128);
      GenOp2(OPStore);

      R:=1;
      if CurTok=TokTO then begin                                      { TO }
        Expect(TokTO);
      end else if CurTok=TokDOWNTO then begin                         { DOWNTO }
        Expect(TokDOWNTO);
        R:=-1;
      end else begin
        Error(129);
      end;

      J:=CodeLabel;

      if I=0 then GenOp2(OPSwap) else GenAddressVar(I);
      GenOp2(OPLoad);
      Expression(X);
      MustBe(T,X);

      if R>0 then GenOp2(OPLeqI) else GenOp2(OPGeqI);
      N:=CodeLabel;
      GenOp(OPJZ,0);
      Expect(TokDO);                                                   { DO }

      Statement;

      if I=0 then GenOp2(OPSwap) else GenAddressVar(I);
      GenOp2(OPLoad);
      GenOp(OPAddC,R);

      if I=0 then GenOp2(OPSwap) else GenAddressVar(I);
      GenOp2(OPStore);
      GenOp(OPJmp,J);
      Code[N+1]:=CodeLabel;
      GenOp(OPAdjS,OldStackPos-StackPos);

    end else begin
      Expect(TokIdent);
    end;

{ -------------------- WHILE --------------------}

  end else if CurTok=TokWHILE then begin                               { WHILE }
    GetToken;
    I:=CodeLabel;
    Expression(T);
    MustBe(TypeBOOL,T);
    Expect(TokDO);
    J:=CodeLabel;
    GenOp(OPJZ,0);
    Statement;
    GenOp(OPJmp,I);
    Code[J+1]:=CodeLabel;

{ -------------------- REPEAT --------------------}

  end else if CurTok=TokREPEAT then begin                              { REPEAT }
    I:=CodeLabel;
    repeat
      GetToken;
      Statement;
    until CurTok<>TokSemi;
    Expect(TokUNTIL);                                                  { UNTIL }
    Expression(T);
    MustBe(TypeBOOL,T);
    GenOp(OPJZ,I);

{ -------------------- BEGIN --------------------}

  end else if CurTok=TokBEGIN then begin                               { BEGIN }
    repeat
      GetToken;
      Statement;
    until CurTok<>TokSemi;
    Expect(TokEND);

{ -------------------- HALT --------------------}

  end else if CurTok=TokHALT then begin                                { HALT }
    GenOp2(OPHalt);
    GetToken;
  end;
  
end;

{   }

procedure Block(L:integer); forward;

procedure Constant(var C,T:integer);
var
  I,S:integer;
begin
  if (CurTok=TokStrC) and (CurStrLen=1) then begin
    C:=ord(CurStr[1]);
    T:=TypeCHAR;
  end else begin

    if CurTok=TokPlus then begin
      GetToken;
      S:=1;
    end  else if CurTok=TokMinus then begin
      GetToken;
      S:=-1;
    end else begin
      S:=0;
    end;

    if CurTok=TokIdent then begin
      I:=Position;
      if IdentTab[I].Kind<>IdCONST then Error(130);
      C:=IdentTab[I].Value;
      T:=IdentTab[I].TypeDef;
    end else if CurTok=TokNumber then begin
      C:=CurNum;
      T:=TypeINT;
    end else begin
      Error(131);
    end;

    if S<>0 then begin
      MustBe(T,TypeINT);
      C:=C*S;
    end;
    
  end;
  GetToken;
end;

procedure ConstDeclaration;
var
  A:TAlfa;
  T,C:integer;
begin
  A:=CurID;
  GetToken;
  Expect(TokEql);
  Constant(C,T);
  Expect(TokSemi);
  EnterTokbol(A,IdCONST,T);
  IdentTab[IdentPos].Value:=C;
end;

{   }

procedure TypeDef(var T:integer); forward;

procedure ArrayType(var T:integer);
var
  X:integer;
begin
  TypeTab[T].Kind:=KindARRAY;
  GetToken;
  Constant(TypeTab[T].StartIndex,X);
  MustBe(TypeINT,X);
  Expect(TokColon);
  Constant(TypeTab[T].EndIndex,X);
  MustBe(TypeINT,X);
  if TypeTab[T].StartIndex>TypeTab[T].EndIndex then Error(132);
  if CurTok=TokComma then begin
    ArrayType(TypeTab[T].SubType);
  end else begin
    Expect(TokRBracket);
    Expect(TokOF);
    TypeDef(TypeTab[T].SubType);
  end;
  TypeTab[T].Size:=(TypeTab[T].EndIndex-TypeTab[T].StartIndex+1)*TypeTab[TypeTab[T].SubType].Size;
end;

{   }

procedure TypeDef(var T:integer);
var
  I,J,SZ,FT:integer;
begin
  if CurTok=TokPACKED then GetToken;
  if CurTok=TokIdent then begin
    I:=Position;
    if IdentTab[I].Kind<>IdTYPE then Error(133);
    T:=IdentTab[I].TypeDef;
    GetToken;
  end else begin
    if TypePos=MaxType then Error(134);
    TypePos:=TypePos+1;
    T:=TypePos;
    if CurTok=TokARRAY then begin                                    { ARRAY }
      GetToken;
      Check(TokLBracket);
      ArrayType(T);
    end else begin
      Expect(TokRECORD);                                             { RECORD }
      if CurLevel=MaxList then Error(135);
      CurLevel:=CurLevel+1;
      TokNameList[CurLevel]:=0;
      Check(TokIdent);
      SZ:=0;
      repeat
        EnterTokbol(CurID,IdFIELD,0);
        I:=IdentPos;
        GetToken;
        while CurTok=TokComma do begin
          GetToken;
          Check(TokIdent);
          EnterTokbol(CurID,IdFIELD,0);
          GetToken;
        end;
        J:=IdentPos;
        Expect(TokColon);
        TypeDef(FT);
        repeat
          IdentTab[I].TypeDef:=FT;
          IdentTab[I].Offset:=SZ;
          SZ:=SZ+TypeTab[FT].Size;
          I:=I+1;
        until I>J;
        if CurTok=TokSemi then GetToken else Check(TokEND);                                             { END }
      until CurTok<>TokIdent;
      TypeTab[T].Size:=SZ;
      TypeTab[T].Kind:=KindRECORD;
      TypeTab[T].Fields:=TokNameList[CurLevel];
      CurLevel:=CurLevel-1;
      Expect(TokEND);
    end;
  end;
end;

{  }

procedure TypeDeclaration;
var
  A:TAlfa;
  T:integer;
begin
  A:=CurID;
  GetToken;
  Expect(TokEql);
  TypeDef(T);
  Expect(TokSemi);
  EnterTokbol(A,IdTYPE,T);
end;

procedure VarDeclaration;
var
  P,Q,T:integer;
begin
  EnterTokbol(CurID,IdVAR,0);
  P:=IdentPos;
  GetToken;
  while CurTok=TokComma do begin
    GetToken;
    Check(TokIdent);
    EnterTokbol(CurID,IdVAR,0);
    GetToken;
  end;
  Q:=IdentPos;
  Expect(TokColon);
  TypeDef(T);
  Expect(TokSemi);
  repeat
    IdentTab[P].VLevel:=CurLevel;
    StackPos:=StackPos-TypeTab[T].Size;
    IdentTab[P].TypeDef:=T;
    IdentTab[P].VAdr:=StackPos;
    IdentTab[P].RefPar:=false;
    P:=P+1;
  until P>Q;
end;

procedure NewParameter(var P,PS:integer);
var
  R:boolean;
  T:integer;
begin
  if CurTok=TokVAR then begin
    R:=true;
    GetToken;
  end else begin
    R:=false;
  end;
  Check(TokIdent);
  P:=IdentPos;
  EnterTokbol(CurID,IdVAR,0);
  GetToken;
  while CurTok=TokComma do begin
    GetToken;
    Check(TokIdent);
    EnterTokbol(CurID,IdVAR,0);
    GetToken;
  end;
  Expect(TokColon);
  Check(TokIdent);
  TypeDef(T);
  while P<IdentPos do begin
    P:=P+1;
    IdentTab[P].TypeDef:=T;
    IdentTab[P].RefPar:=R;
    if R then PS:=PS+4 else PS:=PS+TypeTab[T].Size;
  end;
end;

procedure FunctionDeclaration(IstFunktion:boolean);
var
  F,P,PS,P1,P2,OldStackPos:integer;
begin
  GetToken;
  Check(TokIdent);
  FuncDecl:=-1;
  EnterTokbol(CurID,IdFUNC,0);
  GetToken;
  F:=IdentPos;
  IdentTab[F].FLevel:=CurLevel;
  IdentTab[F].FAdr:=CodeLabel;
  GenOp(OPJmp,0);
  if CurLevel=MaxList then Error(136);
  CurLevel:=CurLevel+1;
  TokNameList[CurLevel]:=0;
  PS:=4;
  OldStackPos:=StackPos;
  if CurTok=TokLParent then begin                                  { ( }
    repeat
      GetToken;
      NewParameter(P,PS);
    until CurTok<>TokSemi;
    Expect(TokRParent);                                             { ) }
  end;
  if CurLevel>1 then begin
    StackPos:=-4;
  end else begin
    StackPos:=0;
  end;
  IdentTab[F].ReturnAddress:=PS;
  P:=F;
  while P<IdentPos do begin
    P:=P+1;
    if IdentTab[P].RefPar then begin
      PS:=PS-4;
    end else begin
      PS:=PS-TypeTab[IdentTab[P].TypeDef].Size;
    end;
    IdentTab[P].VLevel:=CurLevel;
    IdentTab[P].VAdr:=PS;
  end;
  if IstFunktion then begin
  Expect(TokColon);
  Check(TokIdent);
  TypeDef(IdentTab[F].TypeDef);
  if TypeTab[IdentTab[F].TypeDef].Kind<>KindSIMPLE then Error(137);
  end;
  Expect(TokSemi);
  IdentTab[F].LastParameter:=IdentPos;
  if CurTok<>TokFORWARD then begin
    if FuncDecl>=0 then begin
      P1:=FuncDecl+1;
      P2:=F+1;
      while P1<=IdentTab[FuncDecl].LastParameter do begin
        if P2>IdentTab[F].LastParameter then Error(138);
        if not StrCmp(IdentTab[P1].name,IdentTab[P2].name) then Error(139);
        if IdentTab[P1].TypeDef<>IdentTab[P2].TypeDef then Error(140);
        if IdentTab[P1].RefPar<>IdentTab[P2].RefPar then Error(141);
        P1:=P1+1;
        P2:=P2+1;
      end;
      if P2<=IdentTab[F].LastParameter then Error(142);
    end;
    IdentTab[F].Inside:=true;
    Block(IdentTab[F].FAdr);
    IdentTab[F].Inside:=false;
    GenOp(OPExit,IdentTab[F].ReturnAddress-StackPos);
  end else begin
    if FuncDecl>=0 then Error(143);
    GetToken;
  end;
  CurLevel:=CurLevel-1;
  StackPos:=OldStackPos;
  Expect(TokSemi);
end;

procedure Block(L:integer);
var
  I,D,OldStackPos,OldIdentPos:integer;
begin
  OldStackPos:=StackPos;
  OldIdentPos:=IdentPos;
  while (CurTok=TokCONST) or (CurTok=TokTYPE) or (CurTok=TokVAR) or (CurTok=TokFUNC) or (CurTok=TokPROC) do begin

    case CurTok of
      TokCONST:
                begin
                  GetToken;
                  Check(TokIdent);
                  while CurTok=TokIdent do ConstDeclaration;
                end;
      TokTYPE:
                begin
                  GetToken;
                  Check(TokIdent);
                  while CurTok=TokIdent do TypeDeclaration;
                end;
      TokVAR:
                begin
                  GetToken;
                  Check(TokIdent);
                  while CurTok=TokIdent do VarDeclaration;
                end;
      TokFUNC,
      TokPROC: FunctionDeclaration(CurTok=TokFUNC);
    end;

  end;

  if L+1=CodeLabel then
    CodePos:=CodePos-1
  else
    Code[L+1]:=CodeLabel;

  if CurLevel=0 then begin
    GenOp(OPAdjS,StackPos);
  end else begin
    D:=StackPos-OldStackPos;
    StackPos:=OldStackPos;
    GenOp(OPAdjS,D);
  end;
  Statement;
  if CurLevel<>0 then GenOp(OPAdjS,OldStackPos-StackPos);
  I:=OldIdentPos+1;
  while I<=IdentPos do begin
    if IdentTab[I].Kind=IdFUNC then
      if (Code[IdentTab[I].FAdr]=OPJmp) and (Code[IdentTab[I].FAdr+1]=0) then Error(144);
    I:=I+1;
  end;
  IdentPos:=OldIdentPos;
end;

{      }

var
  OCTab : array [1..MaxBinCode] of char;
  OCP   : integer;

procedure OCC(C:char);
begin
  if OCP<MaxBinCode then begin
    OCP:=OCP+1;
    OCTab[OCP]:=C;
  end else begin
    Error(902);
  end;
end;

procedure OC(B:integer);
begin
  OCC(CHR(B));
end;

procedure OCW(I:integer);
begin
  if I>=0 then begin
    OC(I mod 256);
    OC((I div 256) mod 256);
  end else begin
    I:=-(I+1);
    OC(255-(I mod 256));
    OC(255-((I div 256) mod 256));
  end;
end;

procedure OCI(I:integer);
begin
  if I>=0 then begin
    OC(I mod 256);
    OC((I div 256) mod 256);
    OC((I div 65536) mod 256);
    OC(I div 16777216);
  end else begin
    I:=-(I+1);
    OC(255-(I mod 256));
    OC(255-((I div 256) mod 256));
    OC(255-((I div 65536) mod 256));
    OC(255-(I div 16777216));
  end;
end;

function OCGI(O:integer):integer;
begin
  if ord(OCTab[O+3])<$80 then begin
    OCGI:=ord(OCTab[O])+(ord(OCTab[O+1])*256)+(ord(OCTab[O+2])*65536)+(ord(OCTab[O+3])*16777216);
  end else begin
    OCGI:=-(((255-ord(OCTab[O]))+((255-ord(OCTab[O+1]))*256)+((255-ord(OCTab[O+2]))*65536)+((255-ord(OCTab[O+3]))*16777216))+1);
  end;
end;

procedure OCPI(O,I:integer);
begin
  if I>=0 then begin
    OCTab[O]  :=CHR(I mod 256);
    OCTab[O+1]:=CHR((I div 256) mod 256);
    OCTab[O+2]:=CHR((I div 65536) mod 256);
    OCTab[O+3]:=CHR(I div 16777216);
  end else begin
    I:=-(I+1);
    OCTab[O]  :=CHR(255-(I mod 256));
    OCTab[O+1]:=CHR(255-((I div 256) mod 256));
    OCTab[O+2]:=CHR(255-((I div 65536) mod 256));
    OCTab[O+3]:=CHR(255-(I div 16777216));
  end;
end;

procedure WriteOpCode;
var
  I:integer;
begin
  for I:=1 to OCP do write(OCTab[I]);
end;

type
  TOCS= array [1..255] of char;

procedure OCS(S:TOCS);
var
  i:integer;
begin
  for i:=1 to 255 do OCC(S[I]);
end;

{   }
procedure Header;
begin
  OCP:=0;
  OCS('MZ'#0#0#0#0#0#0#0#0#0#0'PE'#0#0'L'#1#1#0#0#0#0#0#0#0#0#0#0#0#0#0''#0#15#3#11#1#0#0''#3#0#0#0#0#0#0#0#0#0#0''#16#0#0#0#16#0#0#12#0#0#0#0#0'@'#0#0#16#0#0#0#2#0#0#4#0#0#0#0#0#0#0#4#0#0#0#0#0#0#0#0' '#0#0#0#2#0#0#0#0#0#0#3#0#0#0#0#0#16#0#0' '#0#0#0#0#16#0#0' '#0#0#0#0#0#0#16#0#0#0#0#0#0#0#0#0#0#0#0#16#0#0''#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0);
  OCS(#0#0#0#0#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0''#3#0#0#0#2#0#0#0#0#0#0#0#0#0#0#0#0#0#0' '#0#0''#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0);
  OCS(#0#0#0#0#0#0#0#0#0#0'('#16#0#0'5'#16#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'kernel32.dll'#0'W'#16#0#0'e'#16#0#0't'#16#0#0''#16#0#0''#16#0#0''#16#0#0''#16#0#0''#16#0#0#0#0#0#0'ExitProcess'#0#0#0'GetStdHandle'#0#0#0'SetConsoleMode'#0#0#0'WriteFile'#0#0#0'ReadFile'#0#0#0'GetProcessHeap'#0#0#0'HeapAlloc'#0#0#0'HeapFree'#0'b'#2#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0);
  OCS(#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'Vt$'#8'`j'#0'h'#21#17'@'#0'j'#1'V5'''#19'@'#0''#21'A'#16'@'#0'a^'#4#0'@'#0'@'#0'@'#0'V\$'#8'D$'#12''#0'}'#10'Kj-3PSt'#12'A'#10#0#0#0'3'#15''#10'[X+ك'#0'~'#12'Qj KuY9'#17'@'#0'Q'#10#0#0#0'3Z0'#31'OYj'#0'h'#21#17'@'#0'Qh:'#17'@'#0'5'''#19'@'#0''#21'A'#16'@'#0'^'#8#0'j'#13'Nj'#10'GÐ@'#0'`j'#0'h'#17'@'#0'j'#1'h'#17'@'#0'5#'#19'@'#0''#21'E'#16'@'#0''#15''#8#5''#18);
  OCS('@'#0'='#17'@'#0#0#15''#8#5''#18'@'#0'a'#0'='#16#18'@'#0#0'u'#12''#5#16#18'@'#0#1''#15''#5''#17'@'#0'`3H'#1'='#18'@'#0#0'uH='#17'@'#0#0't'#16'='#17'@'#0' w'#7'tހ='#17'@'#0'-u'#7'b'#15''#29''#17'@'#0'0r'#19'9w'#14'k'#10'D'#24'Eas='#18'@'#0#0'u'#18''#29''#17'@'#0''#10't'#7'!'#0#15''#5''#18'@'#0'À='#17'@'#0#10#15'Ð@'#0'%'#18'@'#0'5'#31#19'@'#0'h'#0#0#0#0'5'#27#19'@'#0''#21'Q'#16'@'#0'j'#0''#21'5'#16'@'#0''#18'@'#0);
  OCS(#25#17'@'#0'F'#17'@'#0''#17'@'#0#39#18'@'#0'9'#18'@'#0''#18'@'#0''#18'@'#0''#18'@'#0'@'#0'@'#0'@'#0'@'#0'j'#21'9'#16'@'#0'#'#19'@'#0'j'#5'P'#21'='#16'@'#0'j'#21'9'#16'@'#0''''#19'@'#0'j'#3'P'#21'='#16'@'#0'%'#18'@'#0''#21'I'#16'@'#0''#27#19'@'#0'h'#28#0'@'#0'h'#12#0#1#0'P'#21'M'#16'@'#0''#31#19'@'#0''#0#0'@'#0''#18'@'#0'                                                                                                               ');
  OCP:=1419; //  
end;

const
  locNone                               = 0;
  locPushEAX                            = 1;
  locPopEAX                             = 2;
  locPopEBX                             = 3;
  locIMulEBX                            = 4;
  locXorEDXEDX                          = 5;
  locIDivEBX                            = 6;
  locPushEDX                            = 7;
  locCmpEAXEBX                          = 8;
  locMovzxEAXAL                         = 9;
  locMovDWordPtrESPEAX                  = 10;
  locJNZJNE0x03                         = 11;
  locMovDWordPtrEBXEAX                  = 12;
  locJmpDWordPtrESIOfs                  = 13;
  locCallDWordPtrESIOfs                 = 14;
  locXChgEDXESI                         = 15;
  locPopESI                             = 16;
  locMovECXImm                          = 17;
  locCLD                                = 18;
  locREPMOVSB                           = 19;
  locTestEAXEAX                         = 20;
  locNegDWordPtrESP                     = 21;
  locMovEAXDWordPtrESP                  = 22;
  locMovEBXDWordPtrFORStateCurrentValue = 23;
  locCmpDWordPtrEBXEAX                  = 24;
  locMovEAXDWordPtrFORStateDestValue    = 25;

var
  LOCV,PC:integer;

procedure OCPushEAX;
begin
  if LOCV=locPopEAX then begin
    if Code[PC]=OCP then Code[PC]:=Code[PC]-1;
    if OCP>0 then OCP:=OCP-1;
    LOCV:=locNone;
  end else begin
    OC($50);
    LOCV:=locPushEAX;
  end;
end;

procedure OCPopEAX;
begin
  if LOCV=locPushEAX then begin
    if Code[PC]=OCP then Code[PC]:=Code[PC]-1;
    if OCP>0 then OCP:=OCP-1;
    LOCV:=locNone;
  end else begin
    OC($58);
    LOCV:=locPopEAX;
  end;
end;

procedure OCPopEBX;                             begin OC($5b); LOCV:=locPopEBX;end;
procedure OCIMulEBX;                            begin OC($f7); OC($eb);LOCV:=locIMulEBX;end;
procedure OCXorEDXEDX;                          begin OC($33); OC($d2);LOCV:=locXorEDXEDX;end;
procedure OCIDIVEBX;                            begin OC($f7); OC($fb);LOCV:=locIDivEBX;end;
procedure OCPushEDX;                            begin OC($52); LOCV:=locPushEDX;end;
procedure OCCmpEAXEBX;                          begin OC($3b); OC($c3);LOCV:=locCmpEAXEBX;end;
procedure OCMovzxEAXAL;                         begin OC($0f); OC($b6); OC($c0);LOCV:=locMovzxEAXAL;end;
procedure OCJNZJNE0x03;                         begin OC($75); OC($03);LOCV:=locJNZJNE0x03;end;
procedure OCMovDWordPtrESPEAX;                  begin OC($89); OC($04); OC($24);LOCV:=locMovDWordPtrESPEAX;end;
procedure OCMovDWordPtrEBXEAX;                  begin OC($89); OC($03);LOCV:=locMovDWordPtrEBXEAX;end;
procedure OCJmpDWordPtrESIOfs(Ofs:integer);     begin OC($ff); OC($66); OC(Ofs);LOCV:=locJmpDWordPtrESIOfs;end;
procedure OCCallDWordPtrESIOfs(Ofs:integer);    begin OC($ff); OC($56); OC(Ofs);LOCV:=locCallDWordPtrESIOfs;end;
procedure OCXChgEDXESI;                         begin OC($87); OC($d6);LOCV:=locXChgEDXESI;end;
procedure OCPopESI;                             begin OC($5e); LOCV:=locPopESI;end;
procedure OCMovECXImm(Value:integer);           begin OC($b9); OCI(Value);LOCV:=locMovECXImm;end;
procedure OCCLD;                                begin OC($fc); LOCV:=locCLD;end;
procedure OCREPMOVSB;                           begin OC($f3); OC($a4);LOCV:=locREPMOVSB;end;
procedure OCTestEAXEAX;                         begin OC($85); OC($c0); { TEST EAX,EAX }LOCV:=locTestEAXEAX;end;
procedure OCNegDWordPtrESP;                     begin OC($f7); OC($1c); OC($24); { NEG DWORD PTR [ESP] }LOCV:=locNegDWordPtrESP;end;
procedure OCMovEAXDWordPtrESP;                  begin OC($8b); OC($04); OC($24); { MOV EAX,DWORD PTR [ESP] }LOCV:=locMovEAXDWordPtrESP;end;
procedure OCMovEBXDWordPtrFORStateCurrentValue; begin OC($8b); OC($5d); OC($04);LOCV:=locMovEBXDWordPtrFORStateCurrentValue;end;
procedure OCCmpDWordPtrEBXEAX;                  begin OC($39); OC($03);LOCV:=locCmpDWordPtrEBXEAX;end;
procedure OCMovEAXDWordPtrFORStateDestValue;    begin OC($8b); OC($45); OC($08);LOCV:=locMovEAXDWordPtrFORStateDestValue;end;

var
  JCPT: array [1..MaxCode] of integer;

procedure AssembleAndLink;
var
  JCPC,I,D,CS,SA,SOCP:integer;
begin

  Header;
  SOCP:=OCP;
  LOCV:=locNone;
  PC:=0;
  JCPC:=0;

  while PC<CodePos do begin
    I:=Code[PC];
    D:=Code[PC+1];
    Code[PC]:=OCP;
    case I of
        OPAdd:
              begin
                OCPopEAX;
                OC($01); OC($04); OC($24);                        { ADD DWORD PTR [ESP],EAX }
                LOCV:=locNone;
              end;
        OPNeg:
              begin
                OCNegDWordPtrESP;
              end;
        OPMul:
              begin
                OCPopEBX;
                OCPopEAX;
                OCIMulEBX;
                OCPushEAX;
              end;
        OPDivD:
              begin
                OCPopEBX;
                OCPopEAX;
                OCXorEDXEDX;
                OCIDIVEBX;
                OCPushEAX;
              end;
        OPRemD:
              begin
                OCPopEBX;
                OCPopEAX;
                OCXorEDXEDX;
                OCIDIVEBX;
                OCPushEDX;
              end;
        OPDiv2:
              begin
                OC($d1); OC($3c); OC($24);                        { SAR DWORD PTR [ESP],1 }
                LOCV:=locNone;
              end;
        OPRem2:
              begin
                OCPopEAX;
                OC($8b); OC($d8);                                 { MOV EBX,EAX }
                OC($25); OC($01); OC($00); OC($00); OC($80);      { AND EAX,$80000001 }
                OC($79); OC($05);                                 { JNS +$05 }
                OC($48);                                          { DEC EAX }
                OC($83); OC($c8); OC($fe);                        { OR EAX,BYTE -$02 }
                OC($40);                                          { INC EAX }
                LOCV:=locNone;
                OCIMulEBX;
                OCPushEAX;
              end;
        OPEqlI:
              begin
                OCPopEBX;
                OCPopEAX;
                OCCmpEAXEBX;
                OC($0f); OC($94); OC($d0);                        { SETE AL }
                LOCV:=locNone;
                OCMovzxEAXAL;
                OCPushEAX;
              end;
        OPNEqI:
              begin
                OCPopEBX;
                OCPopEAX;
                OCCmpEAXEBX;
                OC($0f); OC($95); OC($d0);                        { SETNE AL }
                LOCV:=locNone;
                OCMovzxEAXAL;
                OCPushEAX;
              end;
        OPLssI:
              begin
                OCPopEBX;
                OCPopEAX;
                OCCmpEAXEBX;
                OC($0f); OC($9c); OC($d0);                        { SETL AL }
                LOCV:=locNone;
                OCMovzxEAXAL;
                OCPushEAX;
              end;
        OPLeqI:
              begin
                OCPopEBX;
                OCPopEAX;
                OCCmpEAXEBX;
                OC($0f); OC($9e); OC($d0);                        { SETLE AL }
                LOCV:=locNone;
                OCMovzxEAXAL;
                OCPushEAX;
              end;
        OPGtrI:
              begin
                OCPopEBX;
                OCPopEAX;
                OCCmpEAXEBX;
                OC($0f); OC($9f); OC($d0);                        { SETG AL }
                LOCV:=locNone;
                OCMovzxEAXAL;
                OCPushEAX;
              end;
        OPGEqi:
              begin
                OCPopEBX;
                OCPopEAX;
                OCCmpEAXEBX;
                OC($0f); OC($9d); OC($d0);                        { SETGE AL }
                LOCV:=locNone;
                OCMovzxEAXAL;
                OCPushEAX;
              end;
        OPDupl:
              begin
                OC($ff); OC($34); OC($24);                        { PUSH DWORD PTR [ESP] }
                LOCV:=locNone;
              end;
        OPSwap:
              begin
                OCPopEBX;
                OCPopEAX;
                OC($53);                                          { PUSH EBX }
                LOCV:=locNone;
                OCPushEAX;
              end;
        OPAndB:
              begin
                OCPopEAX;
                OCTestEAXEAX;
                OCJNZJNE0x03;
                OCMovDWordPtrESPEAX;
                LOCV:=locNone;
              end;
        OPOrB:
              begin
                OCPopEAX;
                OC($83); OC($f8); OC($01);                        { CMP EAX,1 }
                LOCV:=locNone;
                OCJNZJNE0x03;
                OCMovDWordPtrESPEAX;
                LOCV:=locNone;
              end;
        OPLoad:
              begin
                OCPopEAX;
                OC($ff); OC($30);                                 { PUSH DWORD PTR [EAX] }
                LOCV:=locNone;
              end;
        OPStore:
              begin
                OCPopEBX;
                OCPopEAX;
                OCMovDWordPtrEBXEAX;
              end;
        OPHalt: OCJmpDWordPtrESIOfs(0);
        OPWrI:  OCCallDWordPtrESIOfs(8);
        OPWrC:  OCCallDWordPtrESIOfs(4);
        OPWrL:  OCCallDWordPtrESIOfs(12);
        OPRdI:
              begin
                OCPopEBX;
                OCCallDWordPtrESIOfs(20);
                OCMovDWordPtrEBXEAX;
              end;
        OPRdC:
              begin
                OCPopEBX;
                OCCallDWordPtrESIOfs(16);
                OCMovzxEAXAL;
                OCMovDWordPtrEBXEAX;
              end;
        OPRdL:  OCCallDWordPtrESIOfs(24);
        OPEOF:
              begin
                OCCallDWordPtrESIOfs(28);
                OCPushEAX;
              end;
        OPEOL:
              begin
                OCCallDWordPtrESIOfs(32);
                OCPushEAX;
              end;
        OPLdC:
              begin
                if (D>=-128) and (D<=127) then begin
                  OC($6a); OC(D);
                end else begin
                  OC($68); OCI(D);                                { PUSH DWORD D }
                end;
                LOCV:=locNone;
                PC:=PC+1;
              end;
        OPLdA:
              begin
                if D=0 then begin
                  OC($8b); OC($c5);                               { MOV EAX,EBP }
                end else if (D>=-128) and (D<=127) then begin
                  OC($8d); OC($45); OC(D);                        { LEA EAX,[EBP+BYTE D] }
                end else begin
                  OC($8d); OC($85); OCI(D);                       { LEA EAX,[EBP+DWORD D] }
                end;
                LOCV:=locNone;
                OCPushEAX;
                PC:=PC+1;
              end;
        OPLdLA:
              begin
                if D=0 then begin
                  OC($8b); OC($c4);                               { MOV EAX,ESP }
                end else if (D>=-128) and (D<=127) then begin
                  OC($8d); OC($44); OC($24); OC(D);               { LEA EAX,[ESP+BYTE D] }
                end else begin
                  OC($8d); OC($84); OC($24); OCI(D);              { LEA EAX,[ESP+DWORD D] }
                end;
                LOCV:=locNone;
                OCPushEAX;
                PC:=PC+1;
              end;
        OPLdL:
              begin
                if D=0 then begin
                  OCMovEAXDWordPtrESP;
                end else if (D>=-128) and (D<=127) then begin
                  OC($8b); OC($44); OC($24); OC(D);               { MOV EAX,DWORD PTR [ESP+BYTE D] }
                end else begin
                  OC($8b); OC($84); OC($24); OCI(D);              { MOV EAX,DWORD PTR [ESP+DWORD D] }
                end;
                OCPushEAX;
                PC:=PC+1;
              end;
        OPLdG:
              begin
                if (D>=-128) and (D<=127) then begin
                  OC($8b); OC($45); OC(D);                        { MOV EAX,DWORD PTR [EBP+BYTE D] }
                end else begin
                  OC($8b); OC($85); OCI(D);                       { MOV EAX,DWORD PTR [EBP+DWORD D] }
                end;
                LOCV:=locNone;
                OCPushEAX;
                PC:=PC+1;
              end;
        OPStL:
              begin
                OCPopEAX;
                D:=D-4;
                if D=0 then begin
                  OC($89); OC($04); OC($24);                      { MOV DWORD PTR [ESP],EAX }
                end else if (D>=-128) and (D<=127) then begin
                  OC($89); OC($44); OC($24); OC(D);               { MOV DWORD PTR [ESP+BYTE D],EAX }
                end else begin
                  OC($89); OC($84); OC($24); OCI(D);              { MOV EAX,DWORD PTR [ESP+DWORD D] }
                end;
                LOCV:=locNone;
                PC:=PC+1;
              end;
        OPStG:
              begin
                OCPopEAX;
                if (D>=-128) and (D<=127) then begin
                  OC($89); OC($45); OC(D);                        { MOV DWORD PTR [EBP+BYTE D],EAX }
                end else begin
                  OC($89); OC($85); OCI(D);                       { MOV EAX,DWORD PTR [EBP+DWORD D] }
                end;
                LOCV:=locNone;
                PC:=PC+1;
              end;
        OPMove:
              begin
                OCXChgEDXESI;
                OC($5f);                                          { POP EDI }
                LOCV:=locNone;
                OCPopESI;
                OCMovECXImm(D);
                OCCLD;
                OCREPMOVSB;
                OCXChgEDXESI;
                PC:=PC+1;
              end;
        OPCopy:
              begin
                OCXChgEDXESI;
                OCPopESI;
                OCMovECXImm(D);
                OC($2b); OC($e1);                                 { SUB ESP,ECX }
                OC($8b); OC($fc);                                 { MOV EDI,ESP }
                LOCV:=locNone;
                OCCLD;
                OCREPMOVSB;
                OCXChgEDXESI;
                PC:=PC+1;
              end;
        OPAddC:
              begin
                if (D>=-128) and (D<=127) then begin
                  OC($83); OC($04); OC($24); OC(D);               { ADD DWORD PTR [ESP],BYTE D }
                end else begin
                  OC($81); OC($04); OC($24); OCI(D);              { ADD DWORD PTR [ESP],DWORD D }
                end;
                LOCV:=locNone;
                PC:=PC+1;
              end;
        OPMulC:
              begin
                if D=(-1) then begin
                  OCNegDWordPtrESP;
                end else if (D>=-128) and (D<=127) then begin
                  OCPopEAX;
                  OC($6b); OC($c0); OC(D);                        { IMUL EAX,BYTE S }
                  LOCV:=locNone;
                  OCPushEAX;
                end else begin
                  OCPopEAX;
                  OC($69); OC($c0); OCI(D);                       { IMUL EAX,DWORD S }
                  LOCV:=locNone;
                  OCPushEAX;
                end;
                PC:=PC+1;
              end;
        OPJmp:
              begin
                if D<>(PC+2) then begin
                  JCPC:=JCPC+1;
                  OC($e9);                                        { JMP D }
                  JCPT[JCPC]:=OCP+1;
                  OCI(D);
                end;
                PC:=PC+1;
                LOCV:=locNone;
              end;
        OPJZ:
              begin
                JCPC:=JCPC+1;
                OCPopEAX;
                OCTestEAXEAX;
                OC($0f); OC($84);                                 { JZ D }
                JCPT[JCPC]:=OCP+1;
                OCI(D);
                LOCV:=locNone;
                PC:=PC+1;
              end;
        OPCall:
              begin
                JCPC:=JCPC+1;
                OC($e8);                                          { CALL D }
                JCPT[JCPC]:=OCP+1;
                OCI(D);
                LOCV:=locNone;
                PC:=PC+1;
              end;
        OPAdjS:
              begin
                if D>0 then begin
                  if (D>=-128) and (D<=127) then begin
                    OC($83); OC($c4); OC(D);                      { ADD ESP,BYTE D }
                  end else begin
                    OC($81); OC($c4); OCI(D);                     { ADD ESP,DWORD D }
                  end;
                end else if D<0 then begin
                  D:=-D;
                  if (D>=-128) and (D<=127) then begin
                    OC($83); OC($ec); OC(D);                      { SUB ESP,BYTE D }
                  end else begin
                    OC($81); OC($ec); OCI(D);                     { SUB ESP,DWORD D }
                  end;
                end;
                LOCV:=locNone;
                PC:=PC+1;
              end;
        OPExit:
              begin
                D:=D-4;
                if D>0 then begin
                  OC($c2); OCW(D);                                { RET D }
                end else if D=0 then begin
                  OC($c3);                                        { RET }
                end else begin
                  Error(901);
                end;
                LOCV:=locNone;
                PC:=PC+1;
              end;
    end;
    PC:=PC+1;
  end;

  { Patch jumps + calls }
  for I:=1 to JCPC do begin
    D:=JCPT[I];
    OCPI(D,((Code[OCGI(D)]-D)-3));
  end;

  { Size Of Code }
  CS:=OCGI($29)+(OCP-SOCP);
  OCPI($29,CS);

  { Get section alignment }
  SA:=OCGI($45);

  { Calculate and patch section virtual size }
  I:=CS;
  if SA<>0 then begin
    D:=I mod SA;
    if D<>0 then begin
      I:=I+(SA-D);
    end;
  end;
  OCPI($10d,I);

  { Calculate and patch image size }
  OCPI($5d,I+OCGI($39));

  { Patch section raw size }
  OCPI($115,OCGI($115)+(OCP-SOCP));

  WriteOpCode;
end;

begin

  StrCpy(Keywords[TokBEGIN],   'BEGIN               ');
  StrCpy(Keywords[TokEND],     'END                 ');
  StrCpy(Keywords[TokIF],      'IF                  ');
  StrCpy(Keywords[TokTHEN],    'THEN                ');
  StrCpy(Keywords[TokELSE],    'ELSE                ');
  StrCpy(Keywords[TokWHILE],   'WHILE               ');
  StrCpy(Keywords[TokDO],      'DO                  ');
  StrCpy(Keywords[TokCASE],    'CASE                ');
  StrCpy(Keywords[TokREPEAT],  'REPEAT              ');
  StrCpy(Keywords[TokUNTIL],   'UNTIL               ');
  StrCpy(Keywords[TokFOR],     'FOR                 ');
  StrCpy(Keywords[TokTO],      'TO                  ');
  StrCpy(Keywords[TokDOWNTO],  'DOWNTO              ');
  StrCpy(Keywords[TokNOT],     'NOT                 ');
  StrCpy(Keywords[TokDIV],     'DIV                 ');
  StrCpy(Keywords[TokMOD],     'MOD                 ');
  StrCpy(Keywords[TokAND],     'AND                 ');
  StrCpy(Keywords[TokOR],      'OR                  ');
  StrCpy(Keywords[TokCONST],   'CONST               ');
  StrCpy(Keywords[TokVAR],     'VAR                 ');
  StrCpy(Keywords[TokTYPE],    'TYPE                ');
  StrCpy(Keywords[TokARRAY],   'ARRAY               ');
  StrCpy(Keywords[TokOF],      'OF                  ');
  StrCpy(Keywords[TokPACKED],  'PACKED              ');
  StrCpy(Keywords[TokRECORD],  'RECORD              ');
  StrCpy(Keywords[TokPROGRAM], 'PROGRAM             ');
  StrCpy(Keywords[TokFORWARD], 'FORWARD             ');
  StrCpy(Keywords[TokHALT],    'HALT                ');
  StrCpy(Keywords[TokFUNC],    'FUNCTION            ');
  StrCpy(Keywords[TokPROC],    'PROCEDURE           ');

  TypeTab[TypeINT].Size        :=  4;
  TypeTab[TypeINT].Kind        :=  KindSIMPLE;
  TypeTab[TypeCHAR].Size       :=  4;
  TypeTab[TypeCHAR].Kind       :=  KindSIMPLE;
  TypeTab[TypeBOOL].Size       :=  4;
  TypeTab[TypeBOOL].Kind       :=  KindSIMPLE;
  TypeTab[TypeSTR].Size        :=  0;
  TypeTab[TypeSTR].Kind        :=  KindSIMPLE;
  TypePos:=4;

  TokNameList[-1]              :=  0;
  CurLevel                     :=  -1;
  IdentPos                     :=  0;

  EnterTokbol('FALSE               ',IdCONST,TypeBOOL);
  IdentTab[IdentPos].Value:=ord(false);

  EnterTokbol('TRUE                ',IdCONST,TypeBOOL);
  IdentTab[IdentPos].Value:=ord(true);

  EnterTokbol('MAXINT              ',IdCONST,TypeINT);
  IdentTab[IdentPos].Value:=2147483647;

  EnterTokbol('INTEGER             ',IdTYPE,TypeINT);
  EnterTokbol('CHAR                ',IdTYPE,TypeCHAR);
  EnterTokbol('BOOLEAN             ',IdTYPE,TypeBOOL);

  EnterTokbol('CHR                 ',IdFUNC,TypeCHAR);
  IdentTab[IdentPos].FLevel:=-1;
  IdentTab[IdentPos].FAdr:=FunCHR;
  IdentTab[IdentPos].Inside:=false;

  EnterTokbol('ORD                 ',IdFUNC,TypeINT);
  IdentTab[IdentPos].FLevel:=-1;
  IdentTab[IdentPos].FAdr:=FunORD;
  IdentTab[IdentPos].Inside:=false;

  EnterTokbol('WRITE               ',IdFUNC,0);
  IdentTab[IdentPos].FLevel:=-1;
  IdentTab[IdentPos].FAdr:=FunWRITE;

  EnterTokbol('WRITELN             ',IdFUNC,0);
  IdentTab[IdentPos].FLevel:=-1;
  IdentTab[IdentPos].FAdr:=FunWRITELN;

  EnterTokbol('READ                ',IdFUNC,0);
  IdentTab[IdentPos].FLevel:=-1;
  IdentTab[IdentPos].FAdr:=FunREAD;

  EnterTokbol('READLN              ',IdFUNC,0);
  IdentTab[IdentPos].FLevel:=-1;
  IdentTab[IdentPos].FAdr:=FunREADLN;

  EnterTokbol('EOF                 ',IdFUNC,TypeBOOL);
  IdentTab[IdentPos].FLevel:=-1;
  IdentTab[IdentPos].FAdr:=FunEOF;
  IdentTab[IdentPos].Inside:=false;

  EnterTokbol('EOLN                ',IdFUNC,TypeBOOL);
  IdentTab[IdentPos].FLevel:=-1;
  IdentTab[IdentPos].FAdr:=FunEOFLN;
  IdentTab[IdentPos].Inside:=false;

  TokNameList[0]:=0;
  CurLevel:=0;

  LineNum:=1;
  LinePos:=0;

  ReadChar;
  GetToken;
  IsLabeled:=true;
  CodePos:=0;
  LastOpcode:=-1;
  StackPos:=4;
  Expect(TokPROGRAM);
  Expect(TokIdent);
  Expect(TokSemi);
  GenOp(OPJmp,0);
  Block(0);
  GenOp2(OPHalt);
  Check(TokPeriod);
  AssembleAndLink;

end.
