Set Operations |
Constant sets are located into temprary buffer and expression Value holds offset to this buffer. Non-constant sets are always expanded to stack frame.
This procedure calculates operation between two constant sets.
Procedure ConstantSetOperations; Var LeftSet, RightSet: PSetOfByte; begin LeftSet := Ptr (DSeg, LeftExpression.Value.Word); RightSet := Ptr (DSeg, RightExpression.Value.Word); Case Operation of Calc_Add: LeftSet^ := LeftSet^ + RightSet^; Calc_Subtract: LeftSet^ := LeftSet^ - RightSet^; Calc_Multiply: LeftSet^ := LeftSet^ * RightSet^; Calc_IsEqual: LeftExpression.SetConstantBooleanExpression (LeftSet^ = RightSet^); Calc_IsNotEqual: LeftExpression.SetConstantBooleanExpression (LeftSet^ <> RightSet^); Calc_IsLowerOrEqual: LeftExpression.SetConstantBooleanExpression (LeftSet^ <= RightSet^); Calc_IsGreaterOrEqual: LeftExpression.SetConstantBooleanExpression (LeftSet^ >= RightSet^); end; Case Operation of Calc_Add, Calc_Subtract, Calc_Multiply: LeftExpression.SetDataTypeOfSet; end; end; This procedure checks expression for small set and sets its data type accordingly.
Procedure TExpression.SetDataTypeOfSet; Var SetAddress: PWord; First16: Word; N: Byte; SizeType: TIntegerTypeSet; Zero: Boolean; begin SetAddress := Ptr (DSeg, Value.Word); First16 := SetAddress^; SizeType := [it32Bytes]; Zero := True; For N := 1 to 15 do begin Inc (SetAddress); If SetAddress^ <> 0 then Zero := False; end; If Zero then Case Hi (First16) of 0: SizeType := [itUnsigned]; else SizeType := [itUnsigned,it16Bit]; end; DataType := SizeType; end; This procedure generates code for operation between sets: union (+), intersection (*), difference (-) and relations (<=, >=).
Procedure GenerateCodeForSetOperations; Var CommonSetType: TIntegerTypeSet; TempExpression: TExpression; begin CommonSetType := LeftExpression.DataType + RightExpression.DataType; If not (it32Bytes in CommonSetType) then begin LeftExpression.LoadConstantSmallSetIntoValue; LeftExpression.ExtendInteger (CommonSetType); RightExpression.LoadConstantSmallSetIntoValue; RightExpression.ExtendInteger (CommonSetType); Case Operation of Calc_Subtract, Calc_IsLowerOrEqual: RightExpression.NOT_Integer; Calc_IsGreaterOrEqual: begin ExchangeLeftAndRightExpression; RightExpression.NOT_Integer; end; end; Case Operation of Calc_Add: Operation := Calc_OR; Calc_Subtract, Calc_Multiply: Operation := Calc_AND; Calc_IsLowerOrEqual: begin Operation := Calc_AND; IntegerOperations; LeftExpression.SetExpressionToBooleanJump (JE); Exit; end; end; IntegerOperations; Exit; end; Case Operation of Calc_IsEqual..Calc_IsLowerOrEqual: LeftExpression.ExpandSetToStackFrameAndPushPointer (32); else LeftExpression.ExpandSetToStackFrameAndPushPointer (0); end; RightExpression.ExpandSetToStackFrameAndPushPointer (32); If Operation = Calc_IsLowerOrEqual then begin TempExpression := LeftExpression; LeftExpression := RightExpression; RightExpression := TempExpression; end; ConvertToPointerAndPushBothExpressions (LeftExpression, RightExpression); CalculateBothExpressions (LeftExpression, RightExpression); If Operation = Calc_IsLowerOrEqual then begin TempExpression := LeftExpression; LeftExpression := RightExpression; RightExpression := TempExpression; end; Case Operation of Calc_Add, Calc_Subtract, Calc_Multiply: begin Case Operation of Calc_Add: GenerateInstruction_CALL_FAR (SysProc_ZUnion); Calc_Subtract: GenerateInstruction_CALL_FAR (SysProc_ZDifference); Calc_Multiply: GenerateInstruction_CALL_FAR (SysProc_ZIntersect); end; LeftExpression.EndIntermediateCodeSubroutine; LeftExpression.UsedRegisters := [urBX, urDX, urCX, urAX]; end; else begin Case Operation of Calc_IsEqual, Calc_IsNotEqual: GenerateInstruction_CALL_FAR (SysProc_ZEqual); Calc_IsGreaterOrEqual, Calc_IsLowerOrEqual: GenerateInstruction_CALL_FAR (SysProc_ZRelation); end; LeftExpression.EndIntermediateCodeSubroutine; LeftExpression.UsedRegisters := [urBX, urDX, urCX, urAX]; Case Operation of Calc_IsNotEqual: LeftExpression.SetExpressionToBooleanJump (JNE); else LeftExpression.SetExpressionToBooleanJump (JE); end; end; end; end; This procedure loads small set (16 elements or less) into Value.Word from memory at Value.Pointer.
If Location = elConstant then Value.LongInt := Word (Ptr (DSeg, Value.Word)^); end; { This procedure generates code fo operator IN. If set is constant it generates special code to compare ranges of set elements.
Index, StartIndex, N, FoundJumpOpCode: Byte; _8_OrMoreElementRanges: Boolean; Function SearchForSetElementRange: Boolean; begin SearchForSetElementRange := False; Repeat If Index in ExpressionSet^ then Break; Inc (Index); If Index = 0 then Exit; until False; StartIndex := Index; Repeat If not (Index in ExpressionSet^) then Break; Inc (Index); until Index = 0; SearchForSetElementRange := True; end; begin CheckElementAndSetCompatibility (ElementExpression, SetExpression); ElementExpression.CheckOrdinalRange (Ptr (SystemUnitSegment, Byte_TypeOffset)); ExpressionSet := PSetOfByte (Ptr (DSeg, SetExpression.Value.Word)); If SetExpression.Location <> elConstant then begin OperationWithSet (ElementExpression, SetExpression, $01, TEST_Memory_AL, TEST_Memory_ImmediateByte); Exit; end; If ElementExpression.Location = elConstant then begin ElementExpression.SetConstantBooleanExpression (ElementExpression.Value.Byte in ExpressionSet^); Exit; end; Index := 0; { Set is known at compile time } If not SearchForSetElementRange then begin ElementExpression.SetConstantBooleanExpression (False); Exit; end; If Index or StartIndex = 0 then begin ElementExpression.SetConstantBooleanExpression (True); Exit; end; _8_OrMoreElementRanges := True; For N := 1 to 8 do If (Index = 0) or (not SearchForSetElementRange) then begin _8_OrMoreElementRanges := False; Break; end; If _8_OrMoreElementRanges then begin SetExpression.ExpandSetToStackFrameAndPushPointer (32); OperationWithSet (ElementExpression, SetExpression, $01, TEST_Memory_AL, TEST_Memory_ImmediateByte); Exit; end; ElementExpression.Calculate; ElementExpression.LoadExpressionToRegisters (urAX); With ElementExpression do begin Location := elBoolean; DataType := []; Value.ShortCircuitJumps := 0; end; Index := 0; FoundJumpOpCode := 0; While SearchForSetElementRange do begin Repeat If FoundJumpOpCode <> 0 then GenerateCodeForNearJump (ElementExpression.Value.LastJumpToTrue, FoundJumpOpCode); Dec (Index); If Index <> StartIndex then begin If StartIndex <> 0 then begin GenerateInstruction_TwoBytes (CMP_AL_Immediate, StartIndex); FoundJumpOpCode := JNB; If Index = $FF then Break; GenerateCodeForNearJump (ElementExpression.Value.LastJumpToFalse, JB); end; GenerateInstruction_TwoBytes (CMP_AL_Immediate, Index); FoundJumpOpCode := JBE; Break; end; GenerateInstruction_TwoBytes (CMP_AL_Immediate, StartIndex); FoundJumpOpCode := JE; until True; Inc (Index); If Index = 0 then Break; end; With ElementExpression do begin LocationData.JumpIfTrueOpCode := FoundJumpOpCode; ElementExpression.EndIntermediateCodeSubroutine; TypeDefPtr := Ptr (SystemUnitSegment, Boolean_TypeOffset); end; end; { This procedure checks compatibility between element type and set element type and reports error if they don't match.
If ElementExpression.TypeDefPtr^.BaseType < btInteger then Error (OperandTypesDoNotMatchOperator); If SetExpression.TypeDefPtr^.BaseType <> btSet then Error (OperandTypesDoNotMatchOperator); If PSetTypeDefinition (SetExpression.TypeDefPtr)^.BaseSetTypeOffset.TypeOffset <> 0 then begin If PointerFromOffsets (POrdinalTypeDefinition (ElementExpression.TypeDefPtr)^.OrdinalType) <> PointerFromOffsets (POrdinalTypeDefinition ( PointerFromOffsets (PSetTypeDefinition (SetExpression.TypeDefPtr)^.BaseSetTypeOffset))^.OrdinalType) then Error (TypeMismatch); end; end; { This procedure generates code with general non-constant set operation in memory. Var SetSize: Byte; SetElementLowerLimit_div_8: Byte; MaskWord: WordRec; Function RegisterSetSizeInBits: Byte; begin If it16Bit in SetExpression.DataType then RegisterSetSizeInBits := 16 else RegisterSetSizeInBits := 8; end; Procedure GetSetSizeInMemory; begin If SetExpression.Location = elMemory then SetSize := PSetTypeDefinition (SetExpression.TypeDefPtr)^.GetSetSizeAndLowestElementDataOffset (SetElementLowerLimit_div_8) else begin PopPointerAndConvertToMemory (SetExpression); SetSize := 32; SetElementLowerLimit_div_8 := 0; end; end; begin TestSetInForElementMask := Mask; TestMemoryWithRegisterOpCode := TestMemoryRegisterOpCode; TestMemoryWithImmediateOpCode := TestMemoryImmediateOpCode; LastJumpToFalse := 0; Case ElementExpression.Location of elConstant: begin Case SetExpression.Location of elRegister: begin If ElementExpression.Value.Byte >= RegisterSetSizeInBits then begin ElementExpression.SetConstantBooleanExpression (False); Exit; end; SetExpression.Calculate; Case it16Bit in SetExpression.DataType of True: begin GenerateInstruction_Byte (TEST_AX_Immediate); GenerateInstruction_Word ($0001 shl ElementExpression.Value.Byte); end; else begin GenerateInstruction_Byte (TEST_AL_Immediate); GenerateInstruction_Byte ($01 shl ElementExpression.Value.Byte) end; end; end; else begin GetSetSizeInMemory; If (ElementExpression.Value.Byte shr 3 < SetElementLowerLimit_div_8) or (ElementExpression.Value.Byte shr 3 - SetElementLowerLimit_div_8 >= SetSize) then begin ElementExpression.SetConstantBooleanExpression (False); Exit; end; Inc (SetExpression.Value.Word, ElementExpression.Value.Byte shr 3 - SetElementLowerLimit_div_8); SetExpression.Calculate; SetExpression.GenerateInstructionWithExpressionInMemOrReg ( Lo (TestMemoryWithImmediateOpCode), Hi (TestMemoryWithImmediateOpCode)); MaskWord.Word := TestSetInForElementMask shl (ElementExpression.Value.Byte and $07); GenerateInstruction_Byte (MaskWord.ByteL or MaskWord.ByteH); end; end; end; else begin Case it32Bytes in SetExpression.DataType of True: begin GetSetSizeInMemory; ElementExpression.Calculate; ElementExpression.LoadExpressionToRegisters (urAX); GenerateInstruction_TwoBytes (MOV_AH_Immediate, TestSetInForElementMask); GenerateInstruction_Byte (MOV_DX_Immediate); GenerateInstruction_TwoBytes (SetSize, SetElementLowerLimit_div_8); GenerateInstruction_CALL_FAR (SysProc_ZBitMask); With ElementExpression do begin DataType := [it32Bit, it16Bit]; UsedRegisters := [urBX, urDX, urCX, urAX]; end; end; else begin ElementExpression.Calculate; ElementExpression.LoadExpressionToRegisters (urCX); GenerateInstruction_Word (CMP_CL_Immediate); GenerateInstruction_Byte (RegisterSetSizeInBits); GenerateCodeForNearJump (LastJumpToFalse, JNB); If it16Bit in SetExpression.DataType then begin GenerateInstruction_Byte (MOV_AX_Immediate); GenerateInstruction_Word (Integer (ShortInt (TestSetInForElementMask))); GenerateInstruction_Word (ROL_AX_CL); end else begin GenerateInstruction_TwoBytes (MOV_AL_Immediate, TestSetInForElementMask); GenerateInstruction_Word (ROL_AL_CL); end; With ElementExpression do begin DataType := SetExpression.DataType; Include (UsedRegisters, urAX); LocationData.Flags := []; end end; end; ElementExpression.Save (SetExpression.UsedRegisters); SetExpression.Calculate; ElementExpression.PopToRegisters ([urAX]); With SetExpression do If it32Bytes in DataType then begin DataType := [itUnsigned]; Case ofsDI in LocationData.Flags of True: GenerateInstruction_Word (ADD_DI_Register or (rDX or ElementExpression.LocationData.Register) shl 8); else begin Include (SetExpression.LocationData.Flags, ofsDI); GenerateInstruction_Word (MOV_DI_Register or (rDX or ElementExpression.LocationData.Register) shl 8); end; end; ES_DI_PointerDestroyed; end; SetExpression.GenerateInstruction_8_16_bit (TestMemoryWithRegisterOpCode, ElementExpression.LocationData.Register shl 3); end; end; With ElementExpression do begin ElementExpression.EndIntermediateCodeSubroutine; ElementExpression.SetExpressionToBooleanJump (JNE); Value.LastJumpToFalse := LastJumpToFalse; UsedRegisters := UsedRegisters + SetExpression.UsedRegisters; end; end; { |