System Procedure Val
This function processes system procedure Val
.
Function Proc_Val: Word; Far;
Var StringExpression, ValueExpression, ErrorExpression: TExpression;
ValProc: Word;
ValueBaseType: TBaseType;
begin
ExpectTokenAndGetNext (Token_LeftParenthesis);
StringExpression.ExpectAndStoreStringCompatibleExpressionAndPushPointer;
ExpectTokenAndGetNext (Token_Comma);
ValueExpression.ExpectAssignableVariableReferenceExceptProcedureOrFunction;
ValueBaseType := ValueExpression.ExpressionBaseType;
Case ValueBaseType of
btInteger: Case StringExpression.TypeDefPtr^.BaseType of
btString: ValProc := SysProc_ValInt;
else ValProc := SysProc_ValIntC;
end;
btExtended: Case StringExpression.TypeDefPtr^.BaseType of
btString: ValProc := SysProc_ValFloat;
else ValProc := SysProc_ValFloatC;
end;
btReal: Case StringExpression.TypeDefPtr^.BaseType of
btString: ValProc := SysProc_ValReal;
else ValProc := SysProc_ValRealC;
end;
else Error (IntegerOrRealVariableExpected);
end;
ExpectTokenAndGetNext (Token_Comma);
ErrorExpression.Expect16BitIntegerVariable;
ExpectTokenAndGetNext (Token_RightParenthesis);
StringExpression.Calculate;
StoreCode_icGoSub (ErrorExpression.IntermediateCodeOffset);
GenerateInstruction_CALL_FAR (ValProc);
StringExpression.EndIntermediateCodeSubroutine;
With StringExpression do
begin
Case ValueBaseType of
btInteger: begin
Location := elRegister;
DataType := [it32Bit, it16Bit, itSigned];
LocationData.Register := rDX_AX;
end;
btReal: begin
Location := elRegister;
DataType := [it16Bit];
TypeDefPtr := Ptr (SystemUnitSegment, Real_TypeOffset);
end;
btExtended: begin
Location := elStackFrame;
DataType := [fpExtended];
TypeDefPtr := Ptr (SystemUnitSegment, Extended_TypeOffset);
end;
end;
UsedRegisters := [urBX, urDX, urCX, urAX];
end;
StringExpression.AdjustExpressionToType (ValueExpression.TypeDefPtr);
StringExpression.CheckRange (ValueExpression.TypeDefPtr);
GenerateAssignmentIntermediateCode (ValueExpression, StringExpression);
Proc_Val := ValueExpression.IntermediateCodeOffset;
end;