FOR Statement

This procedure processes For statement. It expects assignable variable and loop limits. It generates intermediate code to assign lower limit to control variable, code to increment control variable and code to check for upper limit taking into account Break and Continue jumps.

Procedure TStatement.Process_FOR_Statement;
Type TForStatementData = Record
                           NoLoopComparisonOperation: TCalcOperation;
                           IntegerOpCode,
                           LongIntOpCode_Lo,
                           LongIntOpCode_Hi: Byte;
                         end;

Const ForStatementData_TO: TForStatementData     = (NoLoopComparisonOperation: Calc_IsGreater;
                                                    IntegerOpCode: $00;
                                                    LongIntOpCode_Lo: mod_ADD_rm;
                                                    LongIntOpCode_Hi: mod_ADC_rm);
      ForStatementData_DOWNTO: TForStatementData = (NoLoopComparisonOperation: Calc_IsLower;
                                                    IntegerOpCode: $08;
                                                    LongIntOpCode_Lo: mod_SUB_rm;
                                                    LongIntOpCode_Hi: mod_SBB_rm);

Var SavedLastJumpOutOfBlock, SavedLastJumpToNextBlockIteration: Word;
    JumpToLoopStatement: Word;
    ForStatementData: TForStatementData;
    FOR_Variable, StartValue, EndValue, LoopRepeatComparison, NoLoopComparison, TempStartValue: TExpression;
    LoopStatement: TStatement;

  Procedure Expect_FOR_LoopLimit (Var Expression: TExpression);
  begin
    With Expression do
      begin
        ExpectOrdinalExpression;
        CheckTypeCompatibility (FOR_Variable.TypeDefPtr);
        CheckRange (FOR_Variable.TypeDefPtr);
      end;
  end;

  Procedure Compare_FOR_Variable (Operation: TCalcOperation; Var LeftExpression: TExpression; RightExpression: TExpression);
  begin
    RightExpression.IntermediateCodeOffset := 0;
    CalculateOperation (Operation, LeftExpression, RightExpression);
    With LeftExpression do If Location <> elConstant then
      begin
        Calculate;
        GenerateCodeForNearJump (Value.LastJumpToTrue, LocationData.JumpIfTrueOpCode);
        GenerateLabelAndSetJumpsToIt (Value.LastJumpToFalse);
        EndIntermediateCodeSubroutine
      end;
  end;

  Procedure Next_FOR_VariableValue;
  begin
    With FOR_Variable do
      If it32Bit in DataType then
        begin
          GenerateArithmeticInstructionWithImmediateValue (1, ForStatementData.LongIntOpCode_Lo);
          Inc (FOR_Variable.Value.Offset, 2);
          GenerateArithmeticInstructionWithImmediateValue (0, ForStatementData.LongIntOpCode_Hi);
          Dec (Value.Offset, 2);
        end else GenerateInstruction_8_16_bit ($FE, ForStatementData.IntegerOpCode);
  end;

begin
  SavedLastJumpOutOfBlock := LastJumpOutOfBlock;
  SavedLastJumpToNextBlockIteration := LastJumpToNextBlockIteration;
  LastJumpOutOfBlock := 0;
  LastJumpToNextBlockIteration := 0;
  GetNextToken;
  JumpToLoopStatement := 0;
  With FOR_Variable do
    begin
      ExpectAssignableVariableReferenceExceptProcedureOrFunction;
      If TypeDefPtr^.BaseType < btInteger then Error (Invalid_FOR_ControlVariable);
      If (LocationData.Flags * [segSS, segDS] = []) or (ofsDI in LocationData.Flags) then Error (Invalid_FOR_ControlVariable);
    end;
  ExpectTokenAndGetNext (Token_Assignment);
  Expect_FOR_LoopLimit (StartValue);
  Case Token of
    Token_TO: ForStatementData := ForStatementData_TO;
    Token_DOWNTO: ForStatementData := ForStatementData_DOWNTO;
    else Error (TO_Or_DOWNTO_Expected);
  end;
  GetNextToken;
  Expect_FOR_LoopLimit (EndValue);
  If not ((StartValue.Location = elConstant) and (EndValue.Location = elConstant)) then
    begin
      With StartValue do
        begin
          Calculate;
          LoadExpressionToRegisters (urDX_AX);
          EndIntermediateCodeSubroutine;
        end;
      With EndValue do If Location <> elConstant then
        begin
          StoreIntegerToStackFrame;
          UsedRegisters := [];
        end;
    end;
  ExpectTokenAndGetNext (Token_DO);
  LoopStatement.ProcessStatement;
  NoLoopComparison := StartValue;
  NoLoopComparison.IntermediateCodeOffset := 0;
  Compare_FOR_Variable (ForStatementData.NoLoopComparisonOperation, NoLoopComparison, EndValue);
  LoopRepeatComparison := FOR_Variable;
  LoopRepeatComparison.IntermediateCodeOffset := 0;
  Compare_FOR_Variable (Calc_IsNotEqual, LoopRepeatComparison, EndValue);
  TempStartValue := StartValue;
  TempStartValue.IntermediateCodeOffset := 0;
  GenerateAssignmentIntermediateCode (FOR_Variable, TempStartValue);
  If NoLoopComparison.Location = elConstant then
    begin
      If NoLoopComparison.Value.Byte = 0 then NoLoopComparison.Value.LastJumpToTrue := 0
        else begin
               LastJumpOutOfBlock := SavedLastJumpOutOfBlock;
               LastJumpToNextBlockIteration := SavedLastJumpToNextBlockIteration;
               StatementCode := 0;
               Exit;
             end;
    end;
  StoreCode_icGoSub (EndValue.IntermediateCodeOffset);
  StoreCode_icGoSub (StartValue.IntermediateCodeOffset);
  StoreCode_icGoSub (NoLoopComparison.IntermediateCodeOffset);
  StoreCode_icGoSub (FOR_Variable.IntermediateCodeOffset);
  GenerateCodeForNearJump (JumpToLoopStatement, JMP_ShortDirect);
  GenerateLabelAndSetJumpsToIt (LoopRepeatComparison.Value.LastJumpToTrue);
  Next_FOR_VariableValue;
  GenerateLabelAndSetJumpsToIt (JumpToLoopStatement);
  StoreCode_icGoSub (LoopStatement.StatementCode);
  GenerateLabelAndSetJumpsToIt (LastJumpToNextBlockIteration);
  StoreCode_icGoSub (LoopRepeatComparison.IntermediateCodeOffset);
  JoinJumpsOfBothExpressions (LastJumpOutOfBlock, NoLoopComparison.Value.LastJumpToTrue);
  GenerateLabelAndSetJumpsToIt (LastJumpOutOfBlock);
  StatementCode := EndSubroutine;
  LastJumpOutOfBlock := SavedLastJumpOutOfBlock;
  LastJumpToNextBlockIteration := SavedLastJumpToNextBlockIteration;
end;