Assignment Statement and Procedure Call

This procedure processes assignment statements and procedure/function calls. It first checks for variable expression, then if the token is procedure or function it generates code to call procedure (or function), for functions it processes qualifiers in a loop and stops if it finds assignment token. For assignments it first calculates value expression, it adjusts type if necessary, checks type compatibility and range and generates intermediate code for assignment.

Procedure TStatement.ProcessAssignmentStatementOrProcedureCall;
Var VarExpression, ValueExpression: TExpression;
Label AssignmentFinished;

  Procedure ExpectVariableExpression;
  Var FunctionType: PTypeDefinition;
      FunctionResultOffset: Integer;
      VarFlags: TVarFlagsSet;
  begin
    If (Token = Token_ProcedureIdentifier) and FunctionAsResult (FunctionType, FunctionResultOffset) then
      With VarExpression do
        begin
          TypeDefPtr := FunctionType;
          Value.Word := FunctionResultOffset;
          DataType   := FunctionType^.DataType;
          Location   := elMemory;
          UsedRegisters := [];
          VarFlags := [];
          If Value.Integer >= 0 then VarFlags := [vfVar];
          VarExpression.LoadAddressOfLocalVariable (VarFlags, CurrentIdentifierOffset);
          VarExpression.EndIntermediateCodeSubroutine;
          GetNextToken;
        end else VarExpression.ExpectVariableIdentifier;
  end;

begin
  ExpectVariableExpression;
  With VarExpression do
    begin
      Repeat
        If TypeDefPtr^.BaseType = btFunctionProcedure then
          begin
            Repeat
              If (Location <> elProcedure) and (Token = Token_Assignment) then Break;
              CallProcedure;
              If PProcedureTypeDefinition (TypeDefPtr)^.ResultTypeOffset.TypeOffset = 0 then GoTo AssignmentFinished;
              SetExpressionToFunctionResult;
            until not VarExpression.ProcessQualifiers;
            If not (ExtendedSyntax in ModuleCompilerSwitches) then Break;
            If Token = Token_Assignment then Break;
            RemoveFunctionResultFromStack;
            GoTo AssignmentFinished;
          end;
      until not VarExpression.ProcessQualifiers;
      If (Location <> elMemory) or (efSegment in LocationData.Flags) then Error (InvalidVariableReference);
      Case TypeDefPtr^.BaseType of
        btUntyped,
        btFile,
        btText: Error (IllegalAssignment);
      end;
      ExpectTokenAndGetNext (Token_Assignment);
      ValueExpression.CalculateExpressionWithType (TypeDefPtr);
      ValueExpression.AdjustExpressionToType (TypeDefPtr);
      ValueExpression.CheckTypeCompatibility (TypeDefPtr);
      ValueExpression.CheckRange (TypeDefPtr);
      GenerateAssignmentIntermediateCode (VarExpression, ValueExpression);

AssignmentFinished:

      StatementCode := IntermediateCodeOffset;
    end;
end;

This procedure generates assignment intermediate code.

Procedure GenerateAssignmentIntermediateCode (Var VarExpression, ValueExpression: TExpression);

  Procedure CallSystemProcedure (AX, DX: Word);
  begin
    ConvertToPointerAndPushBothExpressions (ValueExpression, VarExpression);
    CalculateBothExpressions (ValueExpression, VarExpression);
    GenerateCodeToPushWord (DX);
    GenerateInstruction_CALL_FAR (AX);
    VarExpression.EndIntermediateCodeSubroutine
  end;

  Procedure GenerateCodeForSimpleAssignment;
  begin
    If ValueExpression.Location <> elConstant then
      begin
        ValueExpression.Calculate;
        ValueExpression.Save (VarExpression.UsedRegisters);
        VarExpression.Calculate;
        ValueExpression.PopToRegisters ([]);
        VarExpression.GenerateInstruction_MOV_Memory_Register (ValueExpression.LocationData.Register);
        VarExpression.EndIntermediateCodeSubroutine;
        Exit;
      end;
    If (ValueExpression.Value.LongInt = 0) and (it16Bit in VarExpression.DataType) then
      begin
        VarExpression.Calculate;
        GenerateInstruction_Word (XOR_AX_AX);
        VarExpression.GenerateInstruction_16bit_MOV_Memory_Register (rAX);
        If it32Bit in VarExpression.DataType then
          begin
            Inc (VarExpression.Value.Offset, 2);
            VarExpression.GenerateInstruction_16bit_MOV_Memory_Register (rAX);
            Dec (VarExpression.Value.Offset, 2);
          end;
        Include (VarExpression.UsedRegisters, urAX);
        VarExpression.EndIntermediateCodeSubroutine;
        Exit;
      end;
    VarExpression.Calculate;
    VarExpression.GenerateInstruction_MOV_Memory_Immediate (ValueExpression.Value.Word);
    If it32Bit in VarExpression.DataType then
      begin
        Inc (VarExpression.Value.Offset, 2);
        VarExpression.GenerateInstruction_MOV_Memory_Immediate (ValueExpression.Value.LongRec.WordH);
        Dec (VarExpression.Value.Offset, 2);
      end;
    VarExpression.EndIntermediateCodeSubroutine;
  end;

  Procedure GenerateCodeForComplexAssignment;
  begin
    ValueExpression.SetDataTypeForSimpleType;
    If VarExpression.SetDataTypeForSimpleType then GenerateCodeForSimpleAssignment
      else CallSystemProcedure (SysProc_BlockMove, VarExpression.TypeDefptr^.Size);
  end;

  Procedure GenerateCodeForObjectAssignment;
  begin
    If PObjectTypeDefinition (VarExpression.TypeDefPtr)^.VMT_Size = 0 then GenerateCodeForComplexAssignment
      else CallSystemProcedure (SysProc_CopyObject, PObjectTypeDefinition (VarExpression.TypeDefPtr)^.OffsetOf_VMT_Offset);
  end;

  Procedure GenerateCodeForSetAssignment;
  Var SetSize, SetElementLowerLimit_div_8: Byte;
  begin
    If it32Bytes in VarExpression.DataType then
      begin
        ValueExpression.ExpandSetToStackFrameAndPushPointer (32);
        ConvertToPointerAndPushBothExpressions (ValueExpression, VarExpression);
        CalculateBothExpressions (ValueExpression, VarExpression);
        SetSize :=
          PSetTypeDefinition (VarExpression.TypeDefPtr)^.GetSetSizeAndLowestElementDataOffset (SetElementLowerLimit_div_8);
        GenerateCodeToPushWord (SetElementLowerLimit_div_8 shl 8 or SetSize);
        GenerateInstruction_CALL_FAR (SysProc_ZStore);
        VarExpression.EndIntermediateCodeSubroutine;
      end else GenerateCodeForSimpleAssignment;
  end;

  Procedure GeneratoCodeForStringAssignment;
  begin
    If (ValueExpression.Location = elConstant) and (PString (Ptr (DSeg, ValueExpression.Value.Offset))^ = '') then
      begin
        VarExpression.Calculate;
        VarExpression.GenerateInstructionWithExpressionInMemOrReg (MOV_RegisterOrMemory_Immediate, 0);
        GenerateInstruction_Byte (0);
      end else begin
                 VarExpression.PushArrayPointerAndHighestIndex;
                 ValueExpression.StoreStringConstantToCodeBlock;
                 ValueExpression.ConvertToPointerAndPush;
                 CalculateBothExpressions (ValueExpression, VarExpression);
                 GenerateInstruction_CALL_FAR (SysProc_SStore);
               end;
    VarExpression.EndIntermediateCodeSubroutine;
  end;

  Procedure GenerateCodeForExtendedAssignment;
  begin
    ValueExpression.LoadExpressionToFPU;
    CalculateBothExpressions (ValueExpression, VarExpression);
    With VarExpression do
      begin
        Case fpExtended in DataType of
          True: VarExpression.GenerateFPUInstructionWithExpressionInMemory ($D9 or Byte (DataType), $38);
          else  VarExpression.GenerateFPUInstructionWithExpressionInMemory ($D9 or Byte (DataType), $18);
        end;
        GenerateInstruction_TwoBytes ($CD, $3D);
        VarExpression.EndIntermediateCodeSubroutine;
      end;
  end;

  Procedure GenerateCodeForRealAssignment;
  begin
    With VarExpression do
      begin
        Case ValueExpression.Location of
          elConstant: begin
                        VarExpression.Calculate;
                        VarExpression.GenerateInstruction_MOV_Memory_Immediate (ValueExpression.Value.Real1);
                        Inc (Value.Offset, 2);
                        VarExpression.GenerateInstruction_MOV_Memory_Immediate (ValueExpression.Value.Real2);
                        Inc (Value.Offset, 2);
                        VarExpression.GenerateInstruction_MOV_Memory_Immediate (ValueExpression.Value.Real3);
                      end;
          else begin
                 ValueExpression.Calculate;
                 ValueExpression.LoadRealExpressionToRegisterSet (rAX_BX_DX);
                 If UsedRegisters <> [] then
                   begin
                     GenerateInstruction_TwoBytes (PUSH_DX, PUSH_BX);
                     GenerateInstruction_Byte (PUSH_AX);
                   end;
                 VarExpression.Calculate;
                 If UsedRegisters <> [] then
                   begin
                     GenerateInstruction_Byte (PUSH_AX);
                     GenerateInstruction_TwoBytes (POP_BX, POP_DX );
                   end;
                 VarExpression.GenerateInstruction_16bit_MOV_Memory_Register (rAX);
                 Inc (Value.Offset, 2);
                 VarExpression.GenerateInstruction_16bit_MOV_Memory_Register (rBX);
                 Inc (Value.Offset, 2);
                 VarExpression.GenerateInstruction_16bit_MOV_Memory_Register (rDX);
               end;
        end;
        Dec (Value.Offset, 4);
        VarExpression.EndIntermediateCodeSubroutine;
      end;
  end;

begin
  Case VarExpression.TypeDefPtr^.BaseType of
    btUntyped,
    btArray,
    btRecord,
    btFile,
    btText:        GenerateCodeForComplexAssignment;
    btObject:      GenerateCodeForObjectAssignment;
    btFunctionProcedure,
    btPointer,
    btInteger,
    btBoolean,
    btChar,
    btEnumeration: GenerateCodeForSimpleAssignment;
    btSet:         GenerateCodeForSetAssignment;
    btString:      GeneratoCodeForStringAssignment;
    btExtended:    GenerateCodeForExtendedAssignment;
    btReal:        GenerateCodeForRealAssignment;
  end;
end;

This function checks if function name is used as a variable to store function’s result value.

Function FunctionAsResult (Var TypeDef: PTypeDefinition; Var FuncResultOffset: Integer): Boolean;
Var ProceduresBlockRecord: PProceduresBlockRecord;
    ProcedureIdentifierData: PProcedureIdentifierData absolute CurrentIdentifierDataPtr;
begin
  FunctionAsResult := False;
  If Seg (CurrentIdentifierDataPtr^) <> SymbolTable [stMain].Segment then Exit;
  If ProcedureIdentifierData^.ProcedureTypeDefinition.ResultTypeOffset.TypeOffset = 0 then Exit;
  ProceduresBlockRecord := Ptr (SymbolTable [stProcedures].Segment, ProcedureIdentifierData^.ProceduresRecordOffset);
  If ProceduresBlockRecord^.ProgramCodeBlockRecordOffset <> $FFFE then Exit;
  TypeDef := PointerFromOffsets (ProcedureIdentifierData^.ProcedureTypeDefinition.ResultTypeOffset);
  With TypeDef^ do
    begin
      FuncResultOffset := - Size;
      If BaseType = btString then SizeOfPushedParameters (CurrentIdentifierDataPtr, FuncResultOffset);
    end;
  FunctionAsResult := True;
end;