{*******************************************************}
{                                                       }
{       WHY not a compiler? by Y [05-04-00]             }
{       386 assembler code generator                    }
{                                                       }
{       Copyright (c) 1999-2000 CROWELL, Inc.           }
{       All Rights Reserved.                            }
{                                                       }
{*******************************************************}

unit CCodeGenerator; {.$DEFINE DEBUG}

interface

uses Objects, CConstants;

const
  cRegisterNameLength = 3;

type
  TCacheRegister = String[cRegisterNameLength];
  TCacheRegisterValue = record
    Stored: Boolean; {True if Value contains valid information}
    Value: LongInt; {32-bit register content}
  end; {TCacheRegisterValue}

const
  cBufferSize = 16384;
  cMaxCachedElements = 5;
  cValidCacheRegisters: array [1..cMaxCachedElements] of TCacheRegister =
    ('EAX', 'EBX', 'ECX', 'EDX', 'EDI');

type
  PCodeGenerator = ^TCodeGenerator;
  TCodeGenerator = object(TObject)
    FileName: String;
    OutStream: TBufStream;
    Status: Integer;
    LastLabel, LastVariable, LastLineNumber: Integer;
    DebugInfoEmitted: Boolean;

    {optimization feature: cache}
    CachedElements: Integer; {0 thru cMaxCachedElements}
    CacheRegisters: array [1..cMaxCachedElements] of TCacheRegister;
    CacheValues: array[1..cMaxCachedElements] of TCacheRegisterValue;

    {private}
    procedure LoadCache(Elements: Integer);
    procedure FlushCache(Elements: Integer);
    function IsFreeCacheRegister: Boolean;
    function GetFreeCacheRegister: TCacheRegister;
    function IsCacheRegisterFree(Register1: TCacheRegister): Boolean;
    function CacheRegisterPosition(Register1: TCacheRegister): Integer;
    procedure PreserveCacheRegister(Register1: TCacheRegister);
    procedure RestoreCacheRegister(Register1: TCacheRegister);
    procedure SwapCacheRegisters(Register1, Register2: TCacheRegister);
    procedure FreeCacheRegister(Register1: TCacheRegister);
    procedure FlushCacheValue(Number: Integer);
    procedure FlushTopCacheValues(Count: Integer);
    procedure FlushDebugLineNumber;

    {public}
    constructor Init(aFileName: String);
    destructor Done; virtual;
    function GetNewLabel: String;
    function GetNewVariable: String;

    procedure Emit(Line: String);
    procedure EmitLine(Line: String);

    procedure EmitFirst; virtual;
    procedure EmitLast; virtual;
    procedure CodeSegment;
    procedure DataSegment;
    procedure EmitDebugLineNumber(LineNumber: LongInt);
    procedure EmitDebugSourceFile(aFileName: String);

    procedure EmitDataByte(Value: Byte);
    procedure EmitStringConstant(ConstantName: String; Value: String);
    procedure EmitDWordVariable(VariableName: String; Value: LongInt);
    procedure EmitStringVariable(VariableName: String; Value: String);
    procedure EmitDWordArray(VariableName: String; ArraySize: LongInt);
    procedure EmitStringArray(VariableName: String; ArraySize: LongInt);

    procedure EmitPublicSymbol(SymbolName: String);
    procedure EmitExternalSymbol(SymbolName: String; SymbolType: String);
    procedure EmitIncludeDirective(aFileName: String);
    procedure EmitIntegerEquate(Name: String; Value: LongInt);
    procedure EmitLabel(LabelName: String);
    procedure EmitComment(Comment: String);

    procedure EmitJmp(LabelName: String);
    procedure EmitWhileCode(LabelName: String; CacheState: String);
    procedure EmitUntilCode(LabelName: String; CacheState: String);
    function EmitToCode(LabelName1, LabelName2: String): String; {returns cache state}
    function EmitDoCode(LabelName1, LabelName2: String): String; {returns cache state}
    function EmitDowntoCode(LabelName1, LabelName2: String): String; {returns cache state}
    procedure EmitLoopCode(LabelName1, LabelName2: String; CacheState: String);
    function EmitIfCode(LabelName: String): String; {returns cache state}
    procedure EmitDropCode(Drops: Integer);
    procedure EmitDupCode;
    procedure EmitRotCode;
    procedure EmitSwapCode;

    procedure PushIntegerConstant(Value: Longint);
    procedure PushStringConstant(Value: String);
    procedure PushVariable(VariableName: String);
    procedure PushVariablePointer(VariableName: String);
    procedure PushVariablePointerUncached(VariableName: String);
    procedure PushLocalVariable(ProcedureName, VariableName: String);
    procedure Call(ProcedureName: String);
    procedure StartProcedureDefinition(ProcedureName: String);
    procedure FinishProcedureDefinition;
    procedure InitLocals(ProcedureName: String);
    procedure DoneLocals;

    procedure PerformOperation(Operation: String);

    {important optimization control routines}
    function GetCacheState: String;
    procedure SetCacheState(CacheState: String);
    procedure SetCacheTo(CacheState: String);
  end;

type
  PHeaderGenerator = ^THeaderGenerator;
  THeaderGenerator = object(TCodeGenerator)
    procedure EmitFirst; virtual;
    procedure EmitLast; virtual;
  end;

function ValidCacheString(S: String): String;

implementation

function ValidCacheString(S: String): String;
var
  i, Position, MinPosition, FirstRegister: Integer;
  Temp: String;
begin
  Temp := '';

  for i := 1 to Length(S) do
    if (UpCase(S[i]) in Letters) then
       Temp := Temp + UpCase(S[i]);
  S := '';

  MinPosition := Length(Temp); FirstRegister := 0;
  while (MinPosition <> 0) do
  begin
    for i := 1 to cMaxCachedElements do
    begin
      Position := Pos(cValidCacheRegisters[i], Temp);
      if (Position <> 0) then
      begin
        if Position < MinPosition then
        begin
          MinPosition := Position;
          FirstRegister := i;
        end;
      end;
    end;

    if (MinPosition <> Length(Temp)) then
    begin
      S := S + Copy(Temp, MinPosition, cRegisterNameLength);
      Delete(Temp, MinPosition, cRegisterNameLength);
      MinPosition := Length(Temp); FirstRegister := 0;
    end
    else
      MinPosition := 0;
  end;

  ValidCacheString := S;
end; {ValidCacheString}

procedure TCodeGenerator.LoadCache(Elements: Integer);
var
  Delta, i, j: Integer;
  Temp: TCacheRegister;
begin
  if (Elements > cMaxCachedElements) then
    Elements := cMaxCachedElements;

  if (Elements > CachedElements) then
  begin
    {how many extra elements}
    Delta := (Elements - CachedElements);

    {fill in cache}
    for i := Delta downto 1 do
    begin
      {get free cache register}
      Temp := GetFreeCacheRegister;

      {move cache and add one element}
      for j := CachedElements downto 1 do
      begin
        CacheRegisters[j + 1] := CacheRegisters[j];
        CacheValues[j + 1] := CacheValues[j];
      end;

      {put top astack element to cache}
      Inc(CachedElements);
      CacheRegisters[1] := Temp;
      CacheValues[1].Stored := False;

      {generate code to read top element from astack}
      EmitLine(
        #9#9'MOV'#9 + Temp + ', [EBP + ' + IntToStr((Delta - i) * 4) + ']'
      );
    end;

    {update astack counter}
    EmitLine(
      #9#9'ADD'#9'EBP, ' + IntToStr(Delta * 4)
    );
  end;
end; {TCodeGenerator.LoadCache}

procedure TCodeGenerator.FlushCache;
var
  i: Integer;
begin
  if (Elements > CachedElements) then
    Elements := CachedElements;

  if (Elements <> 0) then
  begin
    {push some elements}
    EmitLine(
      #9#9'SUB'#9'EBP, ' + IntToStr(Elements * 4) {4 is EAX size in bytes}
    );
    for i := 1 to Elements do
      if CacheValues[i].Stored then
        EmitLine(
          #9#9'MOV'#9'[EBP + ' + IntToStr((Elements - i) * 4) + '], dword ptr ' +
            IntToStr(CacheValues[i].Value)
        )
      else
        EmitLine(
          #9#9'MOV'#9'[EBP + ' + IntToStr((Elements - i) * 4) + '], ' + CacheRegisters[i]
        );

    {move the cache}
    for i := 1 to CachedElements - Elements do
    begin
      CacheRegisters[i] := CacheRegisters[Elements + i];
      CacheValues[i] := CacheValues[Elements + i];
    end;

    Dec(CachedElements, Elements);
  end;
end; {TCodeGenerator.FlushCache}

function TCodeGenerator.IsFreeCacheRegister: Boolean;
begin
  IsFreeCacheRegister := (CachedElements < cMaxCachedElements);
end; {TCodeGenerator.IsFreeCacheRegister}

function TCodeGenerator.GetFreeCacheRegister: TCacheRegister;
var
  Temp: TCacheRegister;
  Found, Busy: Boolean;
  Number, i: Integer;
begin
  if (IsFreeCacheRegister) then
  begin
    Number := 1; Found := False;
    while (Number <= 4) and not Found do
    begin
      Busy := False;
      if (CachedElements <> 0) then
        for i := 1 to CachedElements do
          if (CacheRegisters[i] = cValidCacheRegisters[Number]) then
            Busy := True;
      if not Busy then
        Found := True
      else
        Inc(Number);
    end;
    Temp := cValidCacheRegisters[Number];
  end
  else
    Temp := 'SUX';

  GetFreeCacheRegister := Temp;
end; {TCodeGenerator.GetFreeCacheRegister}

function TCodeGenerator.IsCacheRegisterFree(Register1: TCacheRegister): Boolean;
var
  Temp: Boolean;
  i: Integer;
begin
  Temp := True;
  if (CachedElements <> 0) then
    for i := 1 to CachedElements do
      if (CacheRegisters[i] = Register1) then
        Temp := False;

  IsCacheRegisterFree := Temp;
end; {TCodeGenerator.IsCacheRegisterFree}

function TCodeGenerator.CacheRegisterPosition(Register1: TCacheRegister): Integer;
var
  Temp: Integer;
  i: Integer;
begin
  Temp := -1;
  if (CachedElements <> 0) then
    for i := 1 to CachedElements do
      if (CacheRegisters[i] = Register1) then
        Temp := i;

  CacheRegisterPosition := Temp;
end; {TCodeGenerator.CacheRegisterPosition}

procedure TCodeGenerator.PreserveCacheRegister(Register1: TCacheRegister);
begin
  if not IsCacheRegisterFree(Register1) then
  begin
    FlushCacheValue(CacheRegisterPosition(Register1));
    EmitLine(
      #9#9'PUSH'#9 + Register1
    );
  end;
end; {TCodeGenerator.PreserveCacheRegister}

procedure TCodeGenerator.RestoreCacheRegister(Register1: TCacheRegister);
begin
  if not IsCacheRegisterFree(Register1) then
    EmitLine(
      #9#9'POP'#9 + Register1
    );
end; {TCodeGenerator.RestoreCacheRegister}

procedure TCodeGenerator.SwapCacheRegisters(Register1, Register2: TCacheRegister);
var
  Pos1, Pos2, i: Integer;
  TempValue: TCacheRegisterValue;
begin
  {perform a test}
  if (Register1 = Register2) then
    Exit;

  Pos1 := -1; Pos2 := -1;

  {find registers in the cache}
  for i := 1 to CachedElements do
    if CacheRegisters[i] = Register1 then
      Pos1 := i;
  for i := 1 to CachedElements do
    if CacheRegisters[i] = Register2 then
      Pos2 := i;

  {swap in cache}
  if (Pos1 <> -1) then
    if (Pos2 <> -1) then
    begin
      CacheRegisters[Pos1] := Register2;
      CacheRegisters[Pos2] := Register1;
      {TempValue := CacheValues[Pos1]; // we don't need to do it!!!!!
      CacheValues[Pos1] := CacheValues[Pos2];
      CacheValues[Pos2] := TempValue;}
    end
    else
    begin {register1 found}
      FlushCacheValue(Pos1);
      CacheRegisters[Pos1] := Register2;
    end
  else
    if (Pos2 <> -1) then
    begin {register2 found}
      FlushCacheValue(Pos2);
      CacheRegisters[Pos2] := Register1;
    end
    else
    begin {no registers found}
      {nothing to do!}
    end;

  {exchange registers} {TODO: do we really need to do this every time???}
  EmitLine(
    #9#9'XCHG'#9 + Register1 + ', ' + Register2
  );
end; {TCodeGenerator.SwapCacheRegisters}

procedure TCodeGenerator.FreeCacheRegister(Register1: TCacheRegister);
begin
  if (not IsCacheRegisterFree(Register1)) then
  begin
    if IsFreeCacheRegister then
      SwapCacheRegisters(Register1, GetFreeCacheRegister)
    else
    begin
      {free up single register}
      FlushCache(1); {free one cache register}
      {move it to the top}
      SwapCacheRegisters(Register1, GetFreeCacheRegister);
    end;
  end;
end; {TCodeGenerator.FreeCacheRegister}

procedure TCodeGenerator.FlushCacheValue(Number: Integer);
begin
  if (Number > 0) and (Number <= CachedElements) then
  begin
    {$IFDEF DEBUG}
    EmitComment('FlushCacheValue(' + CacheRegisters[Number] + ')');
    {$ENDIF DEBUG}
    if CacheValues[Number].Stored then
    begin
      FlushDebugLineNumber;
      CacheValues[Number].Stored := False;
      EmitLine(
        #9#9'MOV'#9 + CacheRegisters[Number] + ', ' + IntToStr(CacheValues[Number].Value)
      );
    end;
  end;
end; {TCodeGenerator.FlushCacheValue}

procedure TCodeGenerator.FlushTopCacheValues(Count: Integer);
var
  i: Integer;
begin
  for i := CachedElements downto CachedElements - Count + 1 do
    if (i > 0) then
      FlushCacheValue(i);
end; {TCodeGenerator.FlushTopCacheValues}

{GetCacheState and SetCacheState used for cache sync. Example:

  // astack is: [EBP] ECX EDX
  "to"
    Sequence
    // astack is: EAX EBX ECX EDX
  "loop"

Astack state after JMP instruction produced by EmitLoopCode() WILL NOT
match the astack state before "to" code. Get/SetCacheState pair solves
this problem:
  ...
    Sequence
    // astack is: EAX EBX ECX EDX
    SetCacheState('ECXEDX');
    // astack is: [EBP] ECX EDX
  "loop"
}
function TCodeGenerator.GetCacheState: String;
var
  Temp: String;
  i: Integer;
begin
  Temp := '';
  for i := 1 to CachedElements do
    Temp := Temp + CacheRegisters[i];

  {$IFDEF DEBUG}
  EmitComment('GetCacheState() returns ' + Temp);
  {$ENDIF DEBUG}
  GetCacheState := Temp;
end; {TCodeGenerator.GetCacheState}

procedure TCodeGenerator.SetCacheState(CacheState: String);
var
  i: Integer;
  Temp: String;
begin
  {$IFDEF DEBUG}
  EmitComment('SetCacheState() performs ' + CacheState);
  {$ENDIF DEBUG}
  GetCacheState;

  {how many registers in cache?}
  i := Length(CacheState) div cRegisterNameLength;

  if (i = 0) then
    FlushCache(cMaxCachedElements)
  else
  begin
    if (i > CachedElements) then
      LoadCache(i); {TODO: remove this shit and implement optimal code}
    if (i < CachedElements) then
      FlushCache(CachedElements - i);
    {i = CachedElements}
    for i := 1 to CachedElements do
    begin
      {match registers}
      Temp := Copy(CacheState, (i - 1) * 3 + 1, 3); {ith register in cache}
      if (CacheRegisters[i] <> Temp) then
        SwapCacheRegisters(Temp, CacheRegisters[i]);
    end;
  end;
end; {TCodeGenerator.SetCacheState}

procedure TCodeGenerator.SetCacheTo(CacheState: String);
var
  i: Integer;
begin
  {how many registers in cache?}
  CachedElements := Length(CacheState) div cRegisterNameLength;
  for i := 1 to CachedElements do
  begin
    CacheRegisters[i] := Copy(CacheState, (i - 1) * 3 + 1, 3);
    CacheValues[i].Stored := False;
  end;
end; {TCodeGenerator.SetCacheTo}

constructor TCodeGenerator.Init(aFileName: String);
begin
  FileName := aFileName;
  OutStream.Init(FileName, stCreate, cBufferSize);
  if (OutStream.Status = 0) then
  begin
    EmitLine(
      '; TCodeGenerator ' + Version + ' by Y [13-12-99]'#13#10 +
      '; Do not edit manually.');
    EmitFirst;
  end;
  LastLabel := 0;
  LastVariable := 0;
  LastLineNumber := -1;
  CachedElements := 0;
  DebugInfoEmitted := False;
end; {TCodeGenerator.Init}

destructor TCodeGenerator.Done;
begin
  EmitLast;
  EmitLine(
    '; End of file.');

  OutStream.Done;
  Status := OutStream.Status;
end; {TCodeGenerator.Done}

procedure TCodeGenerator.EmitFirst;
begin
  EmitLine(#13#10 +
    'IFNDEF ??version'#13#10 +
    ' IF1'#13#10 +
    '  %out *** Error(1): assemble with TASM /m3'#13#10 +
    ' ENDIF'#13#10 +
    ' .ERR'#13#10 +
    'ELSE'#13#10#13#10 +
    '.386p'#13#10 +
    '.MODEL FLAT'#13#10 +
    'INCLUDE WHYRTL32.INC'
  );

  if not (LowerCase(FileName) = 'system.asm') then
    EmitLine('INCLUDE SYSTEM.INC');

  EmitLine(
    '.CODE'#13#10#13#10 +
    #9#9'?debug V 100h'
  );
end; {TCodeGenerator.EmitFirst}

procedure TCodeGenerator.EmitLast;
begin
  EmitLine(
    'ENDIF'#13#10#13#10 +
    #9#9'END'#13#10);
end; {TCodeGenerator.EmitLast}

procedure TCodeGenerator.EmitDebugLineNumber(LineNumber: LongInt);
var
  Temp: String;
begin
  if (LineNumber > LastLineNumber) then
  begin
    LastLineNumber := LineNumber;
    {Str(LineNumber, Temp);
    EmitLine(
      #9#9'?debug L ' + Temp
    );}
    DebugInfoEmitted := True;
  end;
end; {TCodeGenerator.EmitDebugLineNumber}

procedure TCodeGenerator.FlushDebugLineNumber;
var
  Temp: String;
begin
  if DebugInfoEmitted then
  begin
    DebugInfoEmitted := False;
    Str(LastLineNumber, Temp);
    EmitLine(
      #9#9'?debug L ' + Temp
    );
  end;
end; {TCodeGenerator.FlushDebugLineNumber}

procedure TCodeGenerator.EmitDebugSourceFile(aFileName: String);
begin
  EmitLine(
    #9#9'?debug S "' + aFileName + '"'
  );
end; {TCodeGenerator.EmitDebugSourceFile}

function TCodeGenerator.GetNewLabel: String;
var
  Temp: String;
begin
  Inc(LastLabel);
  Str(LastLabel, Temp);
  GetNewLabel := 'LBL' + Temp;
end; {TCodeGenerator.GetNewLabel}

function TCodeGenerator.GetNewVariable: String;
var
  Temp: String;
begin
  Inc(LastVariable);
  Str(LastVariable, Temp);
  GetNewVariable := 'VAR' + Temp;
end; {TCodeGenerator.GetNewVariable}


procedure TCodeGenerator.Emit(Line: String);
begin
  if (OutStream.Status = 0) then
    OutStream.Write(Line[1], Length(Line));

  Status := OutStream.Status;
end; {TCodeGenerator.Emit}

procedure TCodeGenerator.EmitLine(Line: String);
const
  Temp: String = #13#10;
begin
  if (OutStream.Status = 0) then
  begin
    {write line}
    OutStream.Write(Line[1], Length(Line));

    {write CR/LF}
    if (OutStream.Status = 0) then
      OutStream.Write(Temp[1], 2);
  end;
  Status := OutStream.Status;
end; {TCodeGenerator.EmitLine}

procedure TCodeGenerator.CodeSegment;
begin
  EmitLine(
    '.CODE'
  );
end; {TCodeGenerator.CodeSegment}

procedure TCodeGenerator.DataSegment;
begin
  EmitLine(
    '.DATA'
  );
end; {TCodeGenerator.DataSegment}

procedure TCodeGenerator.EmitDataByte(Value: Byte);
var
  Temp: String;
begin
  Str(Value, Temp);
  EmitLine(
    #9#9'DB'#9 + Temp
  );
end; {TCodeGenerator.EmitDataByte}

procedure TCodeGenerator.EmitStringConstant(ConstantName: String; Value: String);
var
  i: Integer;
  Temp, S: String;
  Mode: (mString, mByte, mStart);
  {'"hello there"' - mString, '13, 10, 0' - mByte, '' - mStart}
const
  cBytesPerString = 10;
  cMaxStringLength = 50;
begin
  {EmitLine('PUBLIC'#9#9 + ConstantName);}
  EmitLine(
    ConstantName + #9#9'LABEL BYTE'
  );

  Temp := ''; Mode := mStart;
  for i := 1 to Length(Value) do
  begin
    if Value[i] = '"' then
    begin
      if (Mode = mString) then
        Temp := Temp + '""'
      else if (Mode = mByte) then
        Temp := Temp + ', """'
      else {Mode = mStart}
        Temp := Temp + '"""';
      Mode := mString;
    end
    else if (Value[i] in [#0..#$1F, #$F2..#$FF]) then
    begin
      Str(Byte(Value[i]), S);

      if (Mode = mByte) then
        Temp := Temp + ', ' + S
      else if (Mode = mString) then
        Temp := Temp + '", ' + S
      else {Mode = mStart}
        Temp := Temp + S;
      Mode := mByte;
    end
    else
    begin
      if (Mode = mString) then
        Temp := Temp + Value[i]
      else if (Mode = mByte) then
        Temp := Temp + ', "' + Value[i]
      else {Mode = mStart}
        Temp := Temp + '"' + Value[i];
      Mode := mString;
    end;

    if (Length(Temp) >= cMaxStringLength) then
    begin
      if (Mode = mString) then
        EmitLine(#9#9'DB'#9 + Temp + '"')
      else
        EmitLine(#9#9'DB'#9 + Temp);
      Temp := '';
      Mode := mStart;
    end;
  end;

  if (Temp <> '') then
    if (Mode = mString) then
      EmitLine(#9#9'DB'#9 + Temp + '", 0')
    else
      EmitLine(#9#9'DB'#9 + Temp + ', 0')
  else
    EmitLine(#9#9'DB'#9'0');
end; {TCodeGenerator.EmitStringConstant}

procedure TCodeGenerator.EmitDWordVariable(VariableName: String; Value: LongInt);
var
  Temp: String;
begin
  Str(Value, Temp);
  EmitLine(
    VariableName + #9#9'DD'#9 + Temp
  );
end; {TCodeGenerator.EmitDWordVariable}

procedure TCodeGenerator.EmitStringVariable(VariableName: String; Value: String);
var
  Temp: String;
begin
  if (Value <> '') then
  begin
    Temp := GetNewVariable;
    EmitLine(
      VariableName + #9#9'DD'#9 + Temp
    );
    EmitStringConstant(Temp, Value);
  end
  else
    EmitLine(
      VariableName + #9#9'DD'#9'0'#9'; null string'
    );
end; {TCodeGenerator.EmitStringVariable}

procedure TCodeGenerator.EmitDWordArray(VariableName: String; ArraySize: LongInt);
var
  Temp: String;
begin
  Str(ArraySize, Temp);
  EmitLine(
    VariableName + #9#9'DD'#9 + Temp + ' dup (?)'
  );
end; {TCodeGenerator.EmitDWordArray}

procedure TCodeGenerator.EmitStringArray(VariableName: String; ArraySize: LongInt);
var
  Temp: String;
begin
  Str(ArraySize, Temp);
  EmitLine(
    VariableName + #9#9'DD'#9 + Temp + ' dup (0)'#9'; null strings'
  );
end; {TCodeGenerator.EmitStringArray}

procedure TCodeGenerator.EmitPublicSymbol(SymbolName: String);
begin
  EmitLine(
    'PUBLIC'#9#9 + SymbolName
  );
end; {TCodeGenerator.EmitPublicSymbol}

procedure TCodeGenerator.EmitExternalSymbol(SymbolName: String; SymbolType: String);
begin
  EmitLine(
    'EXTRN'#9#9'_' + SymbolName + ': ' + SymbolType
  );
end; {TCodeGenerator.EmitExternalSymbol}

procedure TCodeGenerator.EmitIncludeDirective(aFileName: String);
begin
  EmitLine(
    'INCLUDE'#9#9 + aFileName
  );
end; {TCodeGenerator.EmitIncludeDirective}

procedure TCodeGenerator.EmitIntegerEquate(Name: String; Value: LongInt);
var
  Temp: String;
begin
  Str(Value, Temp);
  EmitLine(
    #9#9 + Name + ' = ' + Temp
  );
end; {TCodeGenerator.EmitIntegerEquate}

procedure TCodeGenerator.EmitLabel(LabelName: String);
begin
  EmitLine(
    LabelName + ':'
  );
end; {TCodeGenerator.EmitLabel}

procedure TCodeGenerator.EmitComment(Comment: String);
begin
  EmitLine(
    '; ' + Comment
  );
end; {TCodeGenerator.EmitLabel}

{code generation functions start here}

procedure TCodeGenerator.EmitJmp(LabelName: String);
begin
  FlushDebugLineNumber;
  EmitLine(
    #9#9'JMP'#9 + LabelName
  );
end; {TCodeGenerator.EmitJmp}

{ATTENTION: CacheState must match GetCacheState() after "do"}
procedure TCodeGenerator.EmitWhileCode(LabelName: String; CacheState: String);
var
  Label1: String;
  MyCacheState: String;
begin
  {$IFDEF DEBUG}
  EmitComment('EmitWhileCode()');
  {$ENDIF DEBUG}

  FlushDebugLineNumber;

  Label1 := GetNewLabel;
  LoadCache(1);

  if CacheValues[CachedElements].Stored then {stack top register value}
  begin
    if (CacheValues[CachedElements].Value = 0) then
    begin
      EmitDropCode(1);
      EmitLine(
        #9#9'JMP'#9 + Label1
      );
      MyCacheState := GetCacheState;
    end
    else
    begin
      EmitDropCode(1);
      SetCacheState(CacheState);
      EmitLine(
        #9#9'JMP'#9 + LabelName
      );
      MyCacheState := GetCacheState;
    end;
  end
  else
  begin
    EmitLine(
      #9#9'TEST'#9 + CacheRegisters[CachedElements] + ', ' +
        CacheRegisters[CachedElements]
    );
    EmitDropCode(1);
    EmitLine(
      #9#9'JZ'#9 + Label1
    );
    MyCacheState := GetCacheState;
    SetCacheState(CacheState);
    EmitLine(
      #9#9'JMP'#9 + LabelName
    );
  end;

  EmitLabel(Label1);
  SetCacheTo(MyCacheState);
end; {TCodeGenerator.EmitWhileCode}

{ATTENTION: CacheState must match GetCacheState() after "repeat"}
procedure TCodeGenerator.EmitUntilCode(LabelName: String; CacheState: String);
var
  Label1: String;
  MyCacheState: String;
begin
  {$IFDEF DEBUG}
  EmitComment('EmitUntilCode()');
  {$ENDIF DEBUG}

  FlushDebugLineNumber;

  Label1 := GetNewLabel;
  LoadCache(1);

  if CacheValues[CachedElements].Stored then {stack top register value}
  begin
    if (CacheValues[CachedElements].Value <> 0) then
    begin
      EmitDropCode(1);
      EmitLine(
        #9#9'JMP'#9 + Label1
      );
      MyCacheState := GetCacheState;
    end
    else
    begin
      EmitDropCode(1);
      SetCacheState(CacheState);
      EmitLine(
        #9#9'JMP'#9 + LabelName
      );
      MyCacheState := GetCacheState;
    end;
  end
  else
  begin
    EmitLine(
      #9#9'TEST'#9 + CacheRegisters[CachedElements] + ', ' +
        CacheRegisters[CachedElements]
    );
    EmitDropCode(1);
    EmitLine(
      #9#9'JNZ'#9 + Label1
    );
    MyCacheState := GetCacheState;
    SetCacheState(CacheState);
    EmitLine(
      #9#9'JMP'#9 + LabelName
    );
  end;

  EmitLabel(Label1);
  SetCacheTo(MyCacheState);
end; {TCodeGenerator.EmitUntilCode}

function TCodeGenerator.EmitDoCode(LabelName1, LabelName2: String): String;
var
  Temp: String;
begin
  {$IFDEF DEBUG}
  EmitComment('EmitDoCode()');
  {$ENDIF DEBUG}

  FlushDebugLineNumber;

  Temp := GetCacheState;
  LoadCache(2);

  if (CacheValues[CachedElements].Stored and
    CacheValues[CachedElements - 1].Stored) then
  begin
    if (CacheValues[CachedElements].Value >=
      CacheValues[CachedElements - 1].Value) then
      EmitLine(
        LabelName1 + ':'#13#10 +
        #9#9'JMP'#9 + LabelName2
      )
    else
    begin
      FlushCacheValue(CachedElements - 1);
      FlushCacheValue(CachedElements);
      EmitLine(
        LabelName1 + ':'#13#10 +
        #9#9'CMP'#9 + CacheRegisters[CachedElements - 1] + ', ' +
          CacheRegisters[CachedElements] + #13#10 +
        #9#9'JLE'#9 + LabelName2
      );
    end;
  end
  else
  begin
    FlushCacheValue(CachedElements - 1);
    FlushCacheValue(CachedElements);
    EmitLine(
      LabelName1 + ':'#13#10 +
      #9#9'CMP'#9 + CacheRegisters[CachedElements - 1] + ', ' +
        CacheRegisters[CachedElements] + #13#10 +
      #9#9'JLE'#9 + LabelName2
    );
  end;

  EmitDoCode := Temp;
end; {TCodeGenerator.EmitDoCode}

function TCodeGenerator.EmitDowntoCode(LabelName1, LabelName2: String): String;
var
  Temp: String;
begin
  {$IFDEF DEBUG}
  EmitComment('EmitDowntoCode()');
  {$ENDIF DEBUG}

  FlushDebugLineNumber;

  Temp := GetCacheState;
  LoadCache(2);

  if (CacheValues[CachedElements].Stored and
    CacheValues[CachedElements - 1].Stored) then
  begin
    if (CacheValues[CachedElements].Value <
      CacheValues[CachedElements - 1].Value) then
      EmitLine(
        LabelName1 + ':'#13#10 +
        #9#9'JMP'#9 + LabelName2
      )
    else
    begin
      FlushCacheValue(CachedElements - 1);
      FlushCacheValue(CachedElements);
      EmitLine(
        LabelName1 + ':'#13#10 +
        #9#9'CMP'#9 + CacheRegisters[CachedElements - 1] + ', ' +
          CacheRegisters[CachedElements] + #13#10 +
        #9#9'JG'#9 + LabelName2
      );
    end;
  end
  else
  begin
    FlushCacheValue(CachedElements - 1);
    FlushCacheValue(CachedElements);
    EmitLine(
      LabelName1 + ':'#13#10 +
      #9#9'CMP'#9 + CacheRegisters[CachedElements - 1] + ', ' +
        CacheRegisters[CachedElements] + #13#10 +
      #9#9'JG'#9 + LabelName2
    );
  end;

  EmitDowntoCode := Temp;
end; {TCodeGenerator.EmitDowntoCode}

function TCodeGenerator.EmitToCode(LabelName1, LabelName2: String): String;
var
  Temp: String;
begin
  {$IFDEF DEBUG}
  EmitComment('EmitToCode()');
  {$ENDIF DEBUG}

  FlushDebugLineNumber;

  Temp := GetCacheState;
  LoadCache(2);

  if (CacheValues[CachedElements].Stored and
    CacheValues[CachedElements - 1].Stored) then
  begin
    if (CacheValues[CachedElements].Value >
      CacheValues[CachedElements - 1].Value) then
      EmitLine(
        LabelName1 + ':'#13#10 +
        #9#9'JMP'#9 + LabelName2
      )
    else
    begin
      FlushCacheValue(CachedElements - 1);
      FlushCacheValue(CachedElements);
      EmitLine(
        LabelName1 + ':'#13#10 +
        #9#9'CMP'#9 + CacheRegisters[CachedElements - 1] + ', ' +
          CacheRegisters[CachedElements] + #13#10 +
        #9#9'JL'#9 + LabelName2
      );
    end;
  end
  else
  begin
    FlushCacheValue(CachedElements - 1);
    FlushCacheValue(CachedElements);
    EmitLine(
      LabelName1 + ':'#13#10 +
      #9#9'CMP'#9 + CacheRegisters[CachedElements - 1] + ', ' +
        CacheRegisters[CachedElements] + #13#10 +
      #9#9'JL'#9 + LabelName2
    );
  end;

  EmitToCode := Temp;
end; {TCodeGenerator.EmitToCode}

procedure TCodeGenerator.EmitLoopCode(LabelName1, LabelName2: String; CacheState: String);
begin
  {$IFDEF DEBUG}
  EmitComment('EmitLoopCode()');
  {$ENDIF DEBUG}

  FlushDebugLineNumber;

  SetCacheState(CacheState);
  EmitLine(
    #9#9'JMP'#9 + LabelName1
  );
  EmitLabel(LabelName2);
end; {TCodeGenerator.EmitLoopCode}

function TCodeGenerator.EmitIfCode(LabelName: String): String;
var
  Temp: String;
begin
  {$IFDEF DEBUG}
  EmitComment('EmitIfCode()');
  {$ENDIF DEBUG}

  FlushDebugLineNumber;
  LoadCache(1);

  if CacheValues[CachedElements].Stored then
  begin
    if (CacheValues[CachedElements].Value = 0) then {False if}
    begin
      EmitDropCode(1);
      FlushTopCacheValues(cMaxCachedElements);
      Temp := GetCacheState;
      EmitLine(
        #9#9'JMP'#9 + LabelName
      );
    end
    else {True if}
    begin
      EmitDropCode(1);
      FlushTopCacheValues(cMaxCachedElements);
      Temp := GetCacheState;
    end;
  end
  else
  begin
    FlushTopCacheValues(cMaxCachedElements);
    EmitLine(
      #9#9'TEST'#9 + CacheRegisters[CachedElements] + ', ' +
        CacheRegisters[CachedElements]
    );
    EmitDropCode(1);
    Temp := GetCacheState;
    EmitLine(
      #9#9'JZ'#9 + LabelName
    );
  end;

  EmitIfCode := Temp;
end; {TCodeGenerator.EmitIfCode}

procedure TCodeGenerator.EmitDropCode;
var
  Delta, i: Integer;
begin
  Delta := 0;

  for i := 1 to Drops do
    if CachedElements = 0 then
      Inc(Delta, 4)
    else
      Dec(CachedElements);

  if (Delta <> 0) then
  begin
    FlushDebugLineNumber;
    EmitLine(
      #9#9'ADD'#9'EBP, ' + IntToStr(Delta)
    );
  end;
end; {TCodeGenerator.EmitDropCode}

procedure TCodeGenerator.EmitDupCode;
var
  Temp: TCacheRegister;
  i: Integer;
begin
  LoadCache(1);

  if (IsFreeCacheRegister) then
  begin
    Temp := GetFreeCacheRegister;
    if (CacheValues[CachedElements].Stored) then
    begin
      CacheValues[CachedElements + 1].Stored := True;
      CacheValues[CachedElements + 1].Value :=
        CacheValues[CachedElements].Value;
    end
    else
    begin
      FlushDebugLineNumber;

      CacheValues[CachedElements + 1].Stored := False;
      EmitLine(
        #9#9'MOV'#9 + Temp + ', ' + CacheRegisters[CachedElements]
      );
    end;
    CacheRegisters[CachedElements + 1] := Temp;
    Inc(CachedElements);
  end
  else
  begin
    Temp := CacheRegisters[1];

    FlushDebugLineNumber;
    if CacheValues[1].Stored then
      EmitLine(
        #9#9'SUB'#9'EBP, 4'#13#10 +
        #9#9'MOV'#9'[EBP], dword ptr ' +
          IntToStr(CacheValues[1].Value)
      )
    else
      EmitLine(
        #9#9'SUB'#9'EBP, 4'#13#10 +
        #9#9'MOV'#9'[EBP], ' + Temp
      );

    for i := 1 to CachedElements - 1 do
    begin
      CacheRegisters[i] := CacheRegisters[i + 1];
      CacheValues[i] := CacheValues[i + 1];
    end;

    if (CacheValues[CachedElements - 1].Stored) then
    begin
      CacheValues[CachedElements].Stored := True;
      CacheValues[CachedElements].Value :=
        CacheValues[CachedElements - 1].Value;
    end
    else
    begin
      CacheValues[CachedElements].Stored := False;
      EmitLine(
        #9#9'MOV'#9 + Temp + ', ' + CacheRegisters[CachedElements - 1]
      );
    end;

    CacheRegisters[CachedElements] := Temp;
  end;
end; {TCodeGenerator.EmitDupCode}

procedure TCodeGenerator.EmitRotCode;
var
  Temp: TCacheRegister;
  TempValue: TCacheRegisterValue;
begin
  LoadCache(3);
  Temp := CacheRegisters[CachedElements];
  TempValue := CacheValues[CachedElements];

  CacheRegisters[CachedElements] := CacheRegisters[CachedElements - 1];
  CacheValues[CachedElements] := CacheValues[CachedElements - 1];

  CacheRegisters[CachedElements - 1] := CacheRegisters[CachedElements - 2];
  CacheValues[CachedElements - 1] := CacheValues[CachedElements - 2];

  CacheRegisters[CachedElements - 2] := Temp;
  CacheValues[CachedElements - 2] := TempValue;
end; {TCodeGenerator.EmitRotCode}

procedure TCodeGenerator.EmitSwapCode;
var
  Temp: String;
  TempValue: TCacheRegisterValue;
begin
  LoadCache(2);

  Temp := CacheRegisters[CachedElements];
  TempValue := CacheValues[CachedElements];

  CacheRegisters[CachedElements] := CacheRegisters[CachedElements - 1];
  CacheValues[CachedElements] := CacheValues[CachedElements - 1];

  CacheRegisters[CachedElements - 1] := Temp;
  CacheValues[CachedElements - 1] := TempValue;
end; {TCodeGenerator.EmitSwapCode}

procedure TCodeGenerator.PushIntegerConstant(Value: Longint);
var
  Temp: String;
begin
  if not (IsFreeCacheRegister) then
    FlushCache(1); {free one cache register}

  Temp := GetFreeCacheRegister; {must always succeed}
  Inc(CachedElements);
  CacheRegisters[CachedElements] := Temp;
  CacheValues[CachedElements].Stored := True;
  CacheValues[CachedElements].Value := Value;
end; {TCodeGenerator.PushIntegerConstant}

procedure TCodeGenerator.PushStringConstant(Value: String);
var
  Variable1: String;
begin
  Variable1 := GetNewVariable;
  DataSegment;
  EmitStringConstant(Variable1, Value);
  CodeSegment;
  PushVariablePointer(Variable1);
end; {TCodeGenerator.PushStringConstant}

procedure TCodeGenerator.PushVariable(VariableName: String);
var
  Temp: TCacheRegister;
begin
  if not (IsFreeCacheRegister) then
    FlushCache(1); {free one cache register}

  Temp := GetFreeCacheRegister; {must always succeed}
  FlushDebugLineNumber;
  EmitLine(
    #9#9'MOV'#9 + Temp + ', [' + VariableName + ']'
  );
  Inc(CachedElements);
  CacheRegisters[CachedElements] := Temp;
  CacheValues[CachedElements].Stored := False;
end; {TCodeGenerator.PushVariable}

procedure TCodeGenerator.PushVariablePointer(VariableName: String);
var
  Temp: TCacheRegister;
begin
  if not (IsFreeCacheRegister) then
    FlushCache(1); {free one cache register}

  Temp := GetFreeCacheRegister; {must always succeed}
  FlushDebugLineNumber;
  EmitLine(
    #9#9'LEA'#9 + Temp + ', [' + VariableName + ']'
  );
  Inc(CachedElements);
  CacheRegisters[CachedElements] := Temp;
  CacheValues[CachedElements].Stored := False;
end; {TCodeGenerator.PushVariablePointer}

procedure TCodeGenerator.PushVariablePointerUncached(VariableName: String);
var
  Temp: TCacheRegister;
begin
  FlushDebugLineNumber;
  EmitLine(
    #9#9'LEA'#9'EAX, [' + VariableName + ']'#13#10 +
    #9#9'SUB'#9'EBP, 4'#13#10 +
    #9#9'MOV'#9'[EBP], EAX'
  );
end; {TCodeGenerator.PushVariablePointerUncached}

procedure TCodeGenerator.PushLocalVariable(ProcedureName, VariableName: String);
var
  Temp: TCacheRegister;
begin
  if not (IsFreeCacheRegister) then
    FlushCache(1); {free one cache register}

  Temp := GetFreeCacheRegister; {must always succeed}
  FlushDebugLineNumber;
  EmitLine(
    #9#9'LEA'#9 + Temp + ', [ESI - ' + ProcedureName + '_' + VariableName + ']'
  );
  Inc(CachedElements);
  CacheRegisters[CachedElements] := Temp;
  CacheValues[CachedElements].Stored := False;
end; {TCodeGenerator.PushLocalVariable}

procedure TCodeGenerator.Call(ProcedureName: String);
begin
  FlushDebugLineNumber;
  FlushCache(cMaxCachedElements);
  EmitLine(
    #9#9'CALL'#9'_' + ProcedureName
  );
end; {TCodeGenerator.Call}

procedure TCodeGenerator.StartProcedureDefinition(ProcedureName: String);
begin
  EmitComment('------------------------------------------------');
  EmitLine('PUBLIC'#9#9 + '_' + ProcedureName);
  EmitLine(
    '_' + ProcedureName + #9#9'PROC'
  );
end; {TCodeGenerator.StartProcedureDefinition}

procedure TCodeGenerator.FinishProcedureDefinition;
begin
  FlushDebugLineNumber;
  EmitLine(
    #9#9'RET'#13#10 +
    #9#9'ENDP'
  );
end; {TCodeGenerator.FinishProcedureDefinition}

procedure TCodeGenerator.InitLocals(ProcedureName: String);
begin
  FlushDebugLineNumber;
  EmitLine(
    #9#9'PUSH'#9'ESI'#13#10 +
    #9#9'MOV'#9'ESI, ESP'#13#10 +
    #9#9'SUB'#9'ESP, ' + ProcedureName + '_LOCALS'
  );
end; {TCodeGenerator.InitLocals}

procedure TCodeGenerator.DoneLocals;
begin
  FlushDebugLineNumber;
  FlushCache(cMaxCachedElements);
  EmitLine(
    #9#9'MOV'#9'ESP, ESI'#13#10 +
    #9#9'POP'#9'ESI'
  );
end; {TCodeGenerator.DoneLocals}

procedure TCodeGenerator.PerformOperation(Operation: String);
var
  Temp: String;

  {simple binary operation template ;}
  procedure PerformBinaryOperation(Operation: SmallString);

    function CalculateValue(Value1, Value2: LongInt; Operation: SmallString): LongInt;
    var
      Temp: LongInt;
    begin
      if (Operation = '+') then
        Temp := Value1 + Value2
      else if (Operation = '-') then
        Temp := Value1 - Value2
      else if (Operation = '*') then
        Temp := Value1 * Value2
      else if (Operation = '/') then
        if (Value2 <> 0) then
          Temp := Value1 div Value2
        else
          Temp := -1 {divide by zero}
      else if (Operation = '%') then
        if (Value2 <> 0) then
          Temp := Value1 mod Value2
        else
          Temp := -1 {divide by zero}
      else if (Operation = '&') then
        Temp := Value1 and Value2
      else if (Operation = '|') then
        Temp := Value1 or Value2
      else if (Operation = '^') then
        Temp := Value1 xor Value2
      else if (Operation = '<<') then
        Temp := Value1 shl Value2
      else if (Operation = '>>') then
        Temp := Value1 shr Value2
      else
        Temp := 0;

      CalculateValue := Temp;
    end; {CalculateValue}

    {returns 'ADD' for '+' etc}
    function GetOperationString(Operation: SmallString): String;
    var
      Temp: String;
    begin
      if (Operation = '+') then
        Temp := 'ADD'
      else if (Operation = '-') then
        Temp := 'SUB'
      else if (Operation = '*') then
        Temp := 'IMUL'
      else if (Operation = '/') then
        Temp := 'IDIV'
      else if (Operation = '%') then
        Temp := 'IDIV'
      else if (Operation = '&') then
        Temp := 'AND'
      else if (Operation = '|') then
        Temp := 'OR'
      else if (Operation = '^') then
        Temp := 'XOR'
      else if (Operation = '<<') then
        Temp := 'SHL'
      else if (Operation = '>>') then
        Temp := 'SHR'
      else
        Temp := 'ADD';

      GetOperationString := Temp;
    end; {GetOperationString}

  begin
    if (CacheValues[CachedElements].Stored) then
      if (CacheValues[CachedElements - 1].Stored) then
        {all values are known at compile time}
        CacheValues[CachedElements - 1].Value :=
          {perform compile-time operation}
          CalculateValue(CacheValues[CachedElements - 1].Value,
            CacheValues[CachedElements].Value, Operation)
      else
      {value of [CachedElements - 1] element is unknown at compile time}
      begin
        FlushDebugLineNumber;
        EmitLine(
          #9#9 + GetOperationString(Operation) + #9 +
            CacheRegisters[CachedElements - 1] + ', ' +
            IntToStr(CacheValues[CachedElements].Value)
        );
      end
    else
    {no values are known at compile time}
    begin
      FlushDebugLineNumber;
      EmitLine(
        #9#9 + GetOperationString(Operation) + #9 +
          CacheRegisters[CachedElements - 1] + ', ' +
          CacheRegisters[CachedElements]
      );
    end;
    EmitDropCode(1);
  end; {PerformComparisonOperation}

  {comparison operation template ;}
  procedure PerformComparisonOperation(Operation: SmallString);

    function CompareValues(Value1, Value2: LongInt; Operation: SmallString): LongInt;
    var
      Temp: Boolean;
    begin
      if (Operation = '>') then
        Temp := Value1 > Value2
      else if (Operation = '<') then
        Temp := Value1 < Value2
      else if (Operation = '>=') then
        Temp := Value1 >= Value2
      else if (Operation = '<=') then
        Temp := Value1 <= Value2
      else if (Operation = '==') then
        Temp := Value1 = Value2
      else if (Operation = '!=') or (Operation = '<>') then
        Temp := Value1 <> Value2
      else
        Temp := False;

      CompareValues := LongInt(Temp);
    end; {CompareValues}

    {returns 'E' for '==', 'GE' for '>=', 'NE' for '!=' etc}
    function GetOperationString(Operation: SmallString): SmallString;
    var
      Temp: SmallString;
    begin
      if (Operation = '>') then
        Temp := 'G'
      else if (Operation = '<') then
        Temp := 'L'
      else if (Operation = '>=') then
        Temp := 'GE'
      else if (Operation = '<=') then
        Temp := 'LE'
      else if (Operation = '==') then
        Temp := 'E'
      else if (Operation = '!=') or (Operation = '<>') then
        Temp := 'NE'
      else
        Temp := 'E';

      GetOperationString := Temp;
    end; {GetOperationString}

  begin
    if (CacheValues[CachedElements].Stored) then
      if (CacheValues[CachedElements - 1].Stored) then
        {all values are known at compile time}
        CacheValues[CachedElements - 1].Value :=
          {perform compile-time comparison}
          CompareValues(CacheValues[CachedElements - 1].Value,
            CacheValues[CachedElements].Value, Operation)
      else
      {value of [CachedElements - 1] element is unknown at compile time}
      begin
        SwapCacheRegisters('ECX', CacheRegisters[CachedElements - 1]);
        FlushDebugLineNumber;
        EmitLine(
          #9#9'CMP'#9'ECX, ' + IntToStr(CacheValues[CachedElements].Value) + #13#10 +
          #9#9'MOV'#9'ECX, 0'#13#10 +
          #9#9'SET' + GetOperationString(Operation) + #9'CL');
      end
    else
    {values are known at compile time}
    begin
      SwapCacheRegisters('ECX', CacheRegisters[CachedElements - 1]);
      Temp := CacheRegisters[CachedElements];
      FlushDebugLineNumber;
      EmitLine(
        #9#9'CMP'#9'ECX, ' + Temp + #13#10 +
        #9#9'MOV'#9'ECX, 0'#13#10 +
        #9#9'SET' + GetOperationString(Operation) + #9'CL');
    end;
    EmitDropCode(1);
  end; {PerformComparisonOperation}

begin
  {TODO: place things here}
  {$IFDEF DEBUG}
  EmitComment('PerformOperation(): ' + Operation);
  {$ENDIF DEBUG}

  {load cache with one or two top astack element(s)}
  if (Operation <> '->') and (Operation <> '.>') and (Operation <> '++')
    and (Operation <> '--') and (Operation <> '!') then
    LoadCache(2)
  else
    LoadCache(1);

  if (Operation = '+') then             {add}
  begin
    if (CacheValues[CachedElements].Stored) then
      if (CacheValues[CachedElements - 1].Stored) then
        CacheValues[CachedElements - 1].Value :=
          CacheValues[CachedElements - 1].Value +
          CacheValues[CachedElements].Value
      else
      begin
        FlushDebugLineNumber;
        EmitLine(
          #9#9'ADD'#9 + CacheRegisters[CachedElements - 1] + ', ' +
            IntToStr(CacheValues[CachedElements].Value)
        );
      end
    else
    begin
      FlushCacheValue(CachedElements);
      FlushCacheValue(CachedElements - 1);
      FlushDebugLineNumber;
      EmitLine(
        #9#9'ADD'#9 + CacheRegisters[CachedElements - 1] + ', ' +
          CacheRegisters[CachedElements]
      );
    end;
    EmitDropCode(1);
  end
  else if (Operation = '-') then        {substract}
  begin
    if (CacheValues[CachedElements].Stored) then
      if (CacheValues[CachedElements - 1].Stored) then
        CacheValues[CachedElements - 1].Value :=
          CacheValues[CachedElements - 1].Value -
          CacheValues[CachedElements].Value
      else
      begin
        FlushDebugLineNumber;
        EmitLine(
          #9#9'SUB'#9 + CacheRegisters[CachedElements - 1] + ', ' +
            IntToStr(CacheValues[CachedElements].Value)
        );
      end
    else
    begin
      FlushCacheValue(CachedElements);
      FlushCacheValue(CachedElements - 1);
      FlushDebugLineNumber;
      EmitLine(
        #9#9'SUB'#9 + CacheRegisters[CachedElements - 1] + ', ' +
          CacheRegisters[CachedElements]
      );
    end;
    EmitDropCode(1);
  end
  else if (Operation = '*') then        {multiply}
  begin
    if (CacheValues[CachedElements].Stored and
      CacheValues[CachedElements - 1].Stored) then
      CacheValues[CachedElements - 1].Value :=
        CacheValues[CachedElements - 1].Value *
        CacheValues[CachedElements].Value
    else if (CacheValues[CachedElements].Stored) then
    begin
      FlushCacheValue(CachedElements - 1); {will never be performed ;}
      EmitLine(
        #9#9'IMUL'#9 + CacheRegisters[CachedElements - 1] + ', ' +
          IntToStr(CacheValues[CachedElements].Value)
      );
    end
    else
    begin
      FlushCacheValue(CachedElements);
      FlushCacheValue(CachedElements - 1);
      EmitLine(
        #9#9'IMUL'#9 + CacheRegisters[CachedElements - 1] + ', ' +
          CacheRegisters[CachedElements]
      );
    end;
    EmitDropCode(1);
  end
  else if (Operation = '/') then        {divide}
  begin
    if (CacheValues[CachedElements].Stored and
      CacheValues[CachedElements - 1].Stored) then
      if (CacheValues[CachedElements].Value <> 0) then
        CacheValues[CachedElements - 1].Value :=
          CacheValues[CachedElements - 1].Value div
          CacheValues[CachedElements].Value
      else
        CacheValues[CachedElements - 1].Value := -1 {divide by zero}
    else
    begin
      FlushCacheValue(CachedElements);
      FlushCacheValue(CachedElements - 1);
      FreeCacheRegister('EDX');
      SwapCacheRegisters('EAX', CacheRegisters[CachedElements - 1]);
      Temp := CacheRegisters[CachedElements];
      FlushDebugLineNumber;
      EmitLine(
        #9#9'CDQ'#13#10 +
        #9#9'IDIV'#9 + Temp
      );
    end;
    EmitDropCode(1);
  end
  else if (Operation = '%') then        {get division remainder}
  begin
    if (CacheValues[CachedElements].Stored and
      CacheValues[CachedElements - 1].Stored) then
    begin
      if (CacheValues[CachedElements].Value <> 0) then
        CacheValues[CachedElements - 1].Value :=
          CacheValues[CachedElements - 1].Value mod
          CacheValues[CachedElements].Value
      else
        CacheValues[CachedElements - 1].Value := -1; {divide by zero}
      EmitDropCode(1);
    end
    else
    begin
      FlushCacheValue(CachedElements);
      FlushCacheValue(CachedElements - 1);
      FreeCacheRegister('EDX');
      SwapCacheRegisters('EAX', CacheRegisters[CachedElements - 1]);
      Temp := CacheRegisters[CachedElements];
      FlushDebugLineNumber;
      EmitDropCode(1);
      EmitLine(
        #9#9'CDQ'#13#10 +
        #9#9'IDIV'#9 + Temp
      );
      CacheRegisters[CachedElements] := 'EDX';
    end;
  end
  else if (Operation = '&') then        {bitwise and}
  begin
    if (CacheValues[CachedElements].Stored) then
      if (CacheValues[CachedElements - 1].Stored) then
        CacheValues[CachedElements - 1].Value :=
          CacheValues[CachedElements - 1].Value and
          CacheValues[CachedElements].Value
      else
      begin
        FlushDebugLineNumber;
        EmitLine(
          #9#9'AND'#9 + CacheRegisters[CachedElements - 1] + ', ' +
            IntToStr(CacheValues[CachedElements].Value)
        );
      end
    else
    begin
      FlushCacheValue(CachedElements);
      FlushCacheValue(CachedElements - 1);
      FlushDebugLineNumber;
      EmitLine(
        #9#9'AND'#9 + CacheRegisters[CachedElements - 1] + ', ' +
          CacheRegisters[CachedElements]
      );
    end;
    EmitDropCode(1);
  end
  else if (Operation = '|') then        {bitwise or}
  begin
    if (CacheValues[CachedElements].Stored) then
      if (CacheValues[CachedElements - 1].Stored) then
        CacheValues[CachedElements - 1].Value :=
          CacheValues[CachedElements - 1].Value or
          CacheValues[CachedElements].Value
      else
      begin
        FlushDebugLineNumber;
        EmitLine(
          #9#9'OR'#9 + CacheRegisters[CachedElements - 1] + ', ' +
            IntToStr(CacheValues[CachedElements].Value)
        );
      end
    else
    begin
      FlushCacheValue(CachedElements);
      FlushCacheValue(CachedElements - 1);
      FlushDebugLineNumber;
      EmitLine(
        #9#9'OR'#9 + CacheRegisters[CachedElements - 1] + ', ' +
          CacheRegisters[CachedElements]
      );
    end;
    EmitDropCode(1);
  end
  else if (Operation = '~') then        {bitwise not}
  begin
    if CacheValues[CachedElements].Stored then
      CacheValues[CachedElements].Value := not
        CacheValues[CachedElements].Value
    else
    begin
      FlushDebugLineNumber;
      EmitLine(
        #9#9'NOT'#9 + CacheRegisters[CachedElements]
      );
    end;
  end
  else if (Operation = '<-') then       {dword ptr assign}
  begin
    FlushCacheValue(CachedElements);
    if CacheValues[CachedElements - 1].Stored then
    begin
      FlushDebugLineNumber;
      EmitLine(
        #9#9'MOV'#9'[' + CacheRegisters[CachedElements] + '], dword ptr ' +
          IntToStr(CacheValues[CachedElements - 1].Value)
      )
    end
    else
    begin
      FlushDebugLineNumber;
      EmitLine(
        #9#9'MOV'#9'[' + CacheRegisters[CachedElements] + '], ' +
          CacheRegisters[CachedElements - 1]
      );
    end;
    EmitDropCode(2);
  end
  else if (Operation = '->') then       {get dword ptr value}
  begin
    FlushCacheValue(CachedElements);
    FlushDebugLineNumber;
    EmitLine(
      #9#9'MOV'#9 + CacheRegisters[CachedElements] + ', [' +
        CacheRegisters[CachedElements] + ']'
    );
  end
  else if (Operation = '<.') then       {byte ptr assign}
  begin
    FlushCacheValue(CachedElements);
    if CacheValues[CachedElements - 1].Stored then
    begin
      FlushDebugLineNumber;
      EmitLine(
        #9#9'MOV'#9'[' + CacheRegisters[CachedElements] + '], byte ptr ' +
          IntToStr(Byte(CacheValues[CachedElements - 1].Value))
      );
    end
    else
    begin
      SwapCacheRegisters('EAX', CacheRegisters[CachedElements - 1]);
      FlushDebugLineNumber;
      EmitLine(
        #9#9'MOV'#9'[' + CacheRegisters[CachedElements] + '], AL'
      );
    end;
    EmitDropCode(2);
  end
  else if (Operation = '.>') then       {get byte ptr value}
  begin
    FlushCacheValue(CachedElements);
    FlushDebugLineNumber;
    EmitLine(
      #9#9'MOV'#9 + CacheRegisters[CachedElements] + ', [' +
        CacheRegisters[CachedElements] + ']'#13#10 +
      #9#9'AND'#9 + CacheRegisters[CachedElements] + ', 0FFh'
    );
  end
  else if (Operation = '++') then       {increase}
  begin
    if CacheValues[CachedElements].Stored then
      Inc(CacheValues[CachedElements].Value)
    else
    begin
      FlushDebugLineNumber;
      EmitLine(
        #9#9'INC'#9 + CacheRegisters[CachedElements]
      );
    end;
  end
  else if (Operation = '--') then       {decrease}
  begin
    if CacheValues[CachedElements].Stored then
      Dec(CacheValues[CachedElements].Value)
    else
    begin
      FlushDebugLineNumber;
      EmitLine(
        #9#9'DEC'#9 + CacheRegisters[CachedElements]
      );
    end;
  end
  else if (Operation = '--') then       {decrease}
  begin
    if CacheValues[CachedElements].Stored then
      Dec(CacheValues[CachedElements].Value)
    else
    begin
      FlushDebugLineNumber;
      EmitLine(
        #9#9'DEC'#9 + CacheRegisters[CachedElements]
      );
    end;
  end
  else if (Operation = '<<') then       {shift left}
  begin
    if (CacheValues[CachedElements].Stored) then
    begin
      if (CacheValues[CachedElements - 1].Stored) then
        CacheValues[CachedElements - 1].Value :=
          CacheValues[CachedElements - 1].Value shl
          CacheValues[CachedElements].Value
      else
      begin
        FlushDebugLineNumber;
        EmitLine(
          #9#9'SHL'#9 + CacheRegisters[CachedElements - 1] + ', ' +
            IntToStr(CacheValues[CachedElements].Value)
        );
      end
    end
    else
    begin
      FlushCacheValue(CachedElements - 1);
      SwapCacheRegisters(CacheRegisters[CachedElements], 'ECX');
      FlushDebugLineNumber;
      EmitLine(
        #9#9'SHL'#9 + CacheRegisters[CachedElements - 1] + ', CL');
    end;
    EmitDropCode(1);
  end
  else if (Operation = '>>') then       {shift right}
  begin
    if (CacheValues[CachedElements].Stored) then
    begin
      if (CacheValues[CachedElements - 1].Stored) then
        CacheValues[CachedElements - 1].Value :=
          CacheValues[CachedElements - 1].Value shr
          CacheValues[CachedElements].Value
      else
      begin
        FlushDebugLineNumber;
        EmitLine(
          #9#9'SHR'#9 + CacheRegisters[CachedElements - 1] + ', ' +
            IntToStr(CacheValues[CachedElements].Value)
        );
      end
    end
    else
    begin
      FlushCacheValue(CachedElements - 1);
      SwapCacheRegisters(CacheRegisters[CachedElements], 'ECX');
      FlushDebugLineNumber;
      EmitLine(
        #9#9'SHR'#9 + CacheRegisters[CachedElements - 1] + ', CL');
    end;
    EmitDropCode(1);
  end
  else if (Operation = '&&') then       {logical and}
  begin
    if (CacheValues[CachedElements].Stored) then
    begin
      if (CacheValues[CachedElements - 1].Stored) then
        CacheValues[CachedElements - 1].Value :=
          LongInt(CacheValues[CachedElements - 1].Value <> 0) and
          LongInt(CacheValues[CachedElements].Value <> 0)
      else
      begin
        SwapCacheRegisters('EAX', CacheRegisters[CachedElements - 1]);
        if (CacheValues[CachedElements].Value <> 0) then
        begin
          FlushDebugLineNumber;
          EmitLine(
            #9#9'TEST'#9'EAX, EAX'#13#10 +
            #9#9'SETNZ'#9'AL'#13#10 +
            #9#9'AND'#9'AL, 1'
          );
        end
        else
        begin
          CacheValues[CachedElements - 1].Stored := True;
          CacheValues[CachedElements - 1].Value := 0;
        end;
      end;
    end
    else
    begin
      FlushCacheValue(CachedElements);
      FlushCacheValue(CachedElements - 1);
      SwapCacheRegisters(CacheRegisters[CachedElements - 1], 'EAX');
      SwapCacheRegisters(CacheRegisters[CachedElements], 'EBX');
      FlushDebugLineNumber;
      EmitLine(
        #9#9'TEST'#9'EAX, EAX'#13#10 +
        #9#9'SETNZ'#9'AL'#13#10 +
        #9#9'TEST'#9'EBX, EBX'#13#10 +
        #9#9'SETNZ'#9'BL'#13#10 +
        #9#9'AND'#9'EAX, 0Fh'#13#10 +
        #9#9'AND'#9'AL, BL');
    end;
    EmitDropCode(1);
  end
  else if (Operation = '||') then       {logical or}
  begin
    if (CacheValues[CachedElements].Stored) then
    begin
      if (CacheValues[CachedElements - 1].Stored) then
        CacheValues[CachedElements - 1].Value :=
          LongInt(CacheValues[CachedElements - 1].Value <> 0) or
          LongInt(CacheValues[CachedElements].Value <> 0)
      else
      begin
        SwapCacheRegisters('EAX', CacheRegisters[CachedElements - 1]);
        if (CacheValues[CachedElements].Value <> 1) then
        begin
          FlushDebugLineNumber;
          EmitLine(
            #9#9'TEST'#9'EAX, EAX'#13#10 +
            #9#9'SETNZ'#9'AL'#13#10 +
            #9#9'OR'#9'AL, 1'
          );
        end
        else
        begin
          CacheValues[CachedElements - 1].Stored := True;
          CacheValues[CachedElements - 1].Value := 1;
        end;
      end;
    end
    else
    begin
      FlushCacheValue(CachedElements);
      FlushCacheValue(CachedElements - 1);
      SwapCacheRegisters(CacheRegisters[CachedElements - 1], 'EAX');
      SwapCacheRegisters(CacheRegisters[CachedElements], 'EBX');
      FlushDebugLineNumber;
      EmitLine(
        #9#9'TEST'#9'EAX, EAX'#13#10 +
        #9#9'SETNZ'#9'AL'#13#10 +
        #9#9'TEST'#9'EBX, EBX'#13#10 +
        #9#9'SETNZ'#9'BL'#13#10 +
        #9#9'AND'#9'EAX, 0Fh'#13#10 +
        #9#9'OR'#9'AL, BL');
    end;
    EmitDropCode(1);
  end
  else if (Operation = '!') then        {logical not}
  begin
    if CacheValues[CachedElements].Stored then
      CacheValues[CachedElements].Value :=
        LongInt(CacheValues[CachedElements].Value = 0)
    else
    begin
      FlushCacheValue(CachedElements);
      SwapCacheRegisters(CacheRegisters[CachedElements], 'EAX');
      FlushDebugLineNumber;
      EmitLine(
        #9#9'TEST'#9'EAX, EAX'#13#10 +
        #9#9'SETZ'#9'AL'#13#10
      );
    end;
  end
  else if (Operation = '[]') then       {index}
  begin
    if (CacheValues[CachedElements].Stored) then
      if (CacheValues[CachedElements - 1].Stored) then
        CacheValues[CachedElements - 1].Value :=
          CacheValues[CachedElements - 1].Value +
          CacheValues[CachedElements].Value shl 2
      else
      begin
        FlushDebugLineNumber;
        EmitLine(
          #9#9'ADD'#9 + CacheRegisters[CachedElements - 1] + ', ' +
            IntToStr(CacheValues[CachedElements].Value shl 2)
        );
      end
    else
    begin
      FlushCacheValue(CachedElements);
      FlushCacheValue(CachedElements - 1);
      FlushDebugLineNumber;
      EmitLine(
        #9#9'SHL'#9 + Temp + ', 2'#13#10 +
        #9#9'ADD'#9 + CacheRegisters[CachedElements - 1] + ', ' +
          CacheRegisters[CachedElements]
      );
    end;
    EmitDropCode(1);
  end
  {comparison operations}
  else
    if ((Operation = '>') or (Operation = '<') or (Operation = '>=') or
      (Operation = '<=') or (Operation = '==') or (Operation = '<>') or
      (Operation = '!=')) then
      PerformComparisonOperation(Operation)
  else
    EmitComment('PerformOperation() failed: unknown operation ' + Operation);
end; {TCodeGenerator.PerformOperation}

procedure THeaderGenerator.EmitFirst;
begin
  EmitLine('');
  EmitComment('Assembly public declarations');
end; {THeaderGenerator.EmitFirst}

procedure THeaderGenerator.EmitLast;
begin
  EmitLine('');
end; {THeaderGenerator.EmitLast}

end.