System Function TypeOf

This procedure processes system function TypeOf.

Procedure Func_TypeOf; Far;
Var TypeDefPtr: PTypeDefinition;

  Procedure ExpectObjectTypeWithVMT;
  begin
    With PObjectTypeDefinition (TypeDefPtr)^ do If (BaseType <> btObject) or (VMT_Size = 0) then Error (ObjectTypeExpected);
  end;

begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  CheckForDeclaredIdentifier;
  If Token = Token_TypeIdentifier then
    begin
      TypeDefPtr := ExpectTypeIdentifier;
      ExpectObjectTypeWithVMT;
      With Expression^ do
        begin
          IntermediateCodeOffset := 0;
          UsedRegisters := [];
          LocationData.Flags := [efTypedConstant, segDS];
          Location := elPointerToMemory;
          DataType := itLongInt;
          Value.Word := 0;
          Value.W12 := PObjectTypeDefinition (TypeDefPtr)^.VMT_TypedConstantsBlockRecordOffset;
          Value.W14 := Seg (TypeDefPtr^);
        end;
    end else
      begin
        Expression^.ExpectVariableReferenceExceptProcedureOrFunction;
        TypeDefPtr := Expression^.TypeDefPtr;
        ExpectObjectTypeWithVMT;
        Inc (Expression^.Value.Word, PObjectTypeDefinition (TypeDefPtr)^.OffsetOf_VMT_Offset);
        Expression^.Calculate;
        Expression^.DataType := [itUnsigned, it16Bit];
        Expression^.LoadExpressionToRegisters (urAX);
        GenerateInstruction_TwoBytes ($8C, $DA);    { MOV    DX, DS }
        Expression^.EndIntermediateCodeSubroutine;
        Include (Expression^.UsedRegisters, urDX);
        Expression^.DataType := itLongInt;
      end;
  ExpectTokenAndGetNext (Token_RightParenthesis);
  Expression^.TypeDefPtr := Ptr (SystemUnitSegment, Pointer_TypeOffset);
end;