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;
 
 
 
© 2017 Turbo Pascal | Privacy Policy