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 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; end. This function checks if function name is used as 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; |