From 54da7fca575c6e594704cd2e88de6e17503256fb Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 1 Feb 2024 11:55:29 +0100 Subject: [PATCH] Fixing undefined behaviors that Clang 15 removes --- .../VMMaker/CogARMv8Compiler.class.st | 11 +- ...CogOutOfLineLiteralsARMv8Compiler.class.st | 311 ++++++++++++------ 2 files changed, 212 insertions(+), 110 deletions(-) diff --git a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st index ad601266b1..6256386b66 100644 --- a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st +++ b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st @@ -4532,6 +4532,15 @@ CogARMv8Compiler >> isPCRelativeValueLoad: instr [ ^ (instr bitAnd: 2r10011111 << 24) = (1 << 28) ] +{ #category : #testing } +CogARMv8Compiler >> isShiftable16bitImmediate: constant [ + + ^ self + shiftable16bitImmediate: constant + ifTrue: [ :s :v | true ] + ifFalse: [ false ] +] + { #category : #'private-bit-manipulation' } CogARMv8Compiler >> isShiftedMask: aMask [ @@ -5866,7 +5875,7 @@ CogARMv8Compiler >> shiftable16bitImmediate: constant ifTrue: trueAlternativeBlo (constant bitAnd: 16rFFFF) = constant ifTrue: [^trueAlternativeBlock value: 0 value: constant]. - 0 to: 2 do: [:i | | shiftedValue shiftMagnitude | + 0 to: 1 do: [:i | | shiftedValue shiftMagnitude | shiftMagnitude := (1 << i) * 16. shiftedValue := constant >> shiftMagnitude. (shiftedValue << shiftMagnitude = constant and: [ (shiftedValue bitAnd: 16rFFFF) = shiftedValue ]) diff --git a/smalltalksrc/VMMaker/CogOutOfLineLiteralsARMv8Compiler.class.st b/smalltalksrc/VMMaker/CogOutOfLineLiteralsARMv8Compiler.class.st index 34dc07cc5f..ee77dafd33 100644 --- a/smalltalksrc/VMMaker/CogOutOfLineLiteralsARMv8Compiler.class.st +++ b/smalltalksrc/VMMaker/CogOutOfLineLiteralsARMv8Compiler.class.st @@ -462,116 +462,209 @@ CogOutOfLineLiteralsARMv8Compiler >> usesOutOfLineLiteral [ "Answer if the receiver uses an out-of-line literal. Needs only to work for the opcodes created with gen:literal:operand: et al." - | offset | - - + | offset | opcode caseOf: { - [CallFull] -> [^true]. - [JumpFull] -> [^true]. - "Arithmetic" - [AddCqR] -> [ | constant | - constant := operands at: 0. - ^ (constant abs bitAnd: 16rfff) ~= constant abs]. - [AndCqR] -> [^ self - encodeLogicalImmediate: (operands at: 0) - registerSize: 64 - ifPossible: [ :value | false ] - ifNotPossible: [ true ] ]. - [AndCqRR] -> [^ self - encodeLogicalImmediate: (operands at: 0) - registerSize: 64 - ifPossible: [ :value | false ] - ifNotPossible: [ true ]]. - [CmpCqR] -> [ - ((operands at: 0) abs bitAnd: 16rFFF) = (operands at: 0) abs ifTrue: [ ^ false ]. - ((operands at: 0) abs << 12 >> 12 bitAnd: 16rFFF) = (operands at: 0) abs ifTrue: [ ^ false ]. - ^ true]. - [CmpC32R] -> [^self rotateable8bitSignedImmediate: (operands at: 0) ifTrue: [:r :i :n| false] ifFalse: [true]]. - [OrCqR] -> [^self - encodeLogicalImmediate: (operands at: 0) - registerSize: 64 - ifPossible: [ :v | false ] - ifNotPossible: [ true ]]. - - [SubCqR] -> [ | constant | - constant := operands at: 0. - ^ (constant bitAnd: 16rfff) ~= constant ]. - [TstCqR] -> [ ^self - encodeLogicalImmediate: (operands at: 0) - registerSize: 64 - ifPossible: [ :v | false ] - ifNotPossible: [ true ] ]. - [XorCqR] -> [^self rotateable8bitBitwiseImmediate: (operands at: 0) ifTrue: [:r :i :n| false] ifFalse: [true]]. - [AddCwR] -> [^true]. - [AndCwR] -> [^true]. - [CmpCwR] -> [^true]. - [OrCwR] -> [^true]. - [SubCwR] -> [^true]. - [XorCwR] -> [^true]. - [LoadEffectiveAddressMwrR] - -> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]]. - "Data Movement" - [MoveCqR] -> [^ self shiftable16bitImmediate: (operands at: 0) abs - ifTrue: [ :s :v | false ] ifFalse: [ true ]]. - [MoveC32R] -> [ ^ self shiftable16bitImmediate: (operands at: 0) abs - ifTrue: [ :s :v | false ] ifFalse: [ true ] ]. - - [MoveCwR] -> [^(self inCurrentCompilation: (operands at: 0)) not]. - [MoveAwR] -> [^(self isAddressRelativeToVarBase: (operands at: 0)) ifTrue: [false] ifFalse: [true]]. - [MoveRAw] -> [^(self isAddressRelativeToVarBase: (operands at: 1)) ifTrue: [false] ifFalse: [true]]. - [MoveAbR] -> [^(self isAddressRelativeToVarBase: (operands at: 0)) ifTrue: [false] ifFalse: [true]]. - [MoveRAb] -> [^(self isAddressRelativeToVarBase: (operands at: 1)) ifTrue: [false] ifFalse: [true]]. - - - [MoveRM32r] -> [self is9BitValue: (operands at: 1) - ifTrue: [ :value | ^ false ] - ifFalse: [ self shiftable16bitImmediate: (operands at: 1) - ifTrue: [ :value :shift | ^ false ] - ifFalse: [ ^ true ] ]]. - - [MoveRMwr] -> [self is9BitValue: (operands at: 1) - ifTrue: [ :value | ^ false ] - ifFalse: [ self shiftable16bitImmediate: (operands at: 1) - ifTrue: [ :value :shift | ^ false ] - ifFalse: [ ^ true ] ]]. - - [MoveRsM32r] -> [^self is12BitValue: (operands at: 1) ifTrue: [:s :v| false] ifFalse: [true]]. - [MoveRdM64r] -> [^self is12BitValue: (operands at: 1) ifTrue: [:s :v| false] ifFalse: [true]]. - [MoveMbrR] -> [^self is9BitValue: (operands at: 0) ifTrue: [:v| false] ifFalse: [true]]. - [MoveRMbr] -> [^self is12BitValue: (operands at: 1) ifTrue: [:s :v| false] ifFalse: [true]]. - [MoveRM8r] -> [^self is12BitValue: (operands at: 1) ifTrue: [:s :v| false] ifFalse: [true]]. - [MoveM16rR] -> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]]. - [MoveRM16r] -> [^self is12BitValue: (operands at: 1) ifTrue: [:s :v| false] ifFalse: [true]]. - [MoveM32rRs] -> [^self is12BitValue: (operands at: 0) ifTrue: [:s :v| false] ifFalse: [true]]. - [MoveM64rRd] -> [^self is12BitValue: (operands at: 0) ifTrue: [:s :v| false] ifFalse: [true]]. - - [MoveM32rR] -> [ offset := (operands at: 0). - (offset >= 0 and: [ (offset bitAnd: 16rFFF) = offset ]) - ifTrue: [ ^ false ] - ifFalse: [ self - is9BitValue: offset - ifTrue: [ :v | ^ false ] - ifFalse: [^ true ] ] ]. - - [MoveMwrR] -> [ - offset := (operands at: 0). - (offset >= 0 and: [ (offset bitAnd: 16rFFF) = offset ]) - ifTrue: [ ^ false ] - ifFalse: [ self - is9BitValue: offset - ifTrue: [ :v | ^ false ] - ifFalse: [^ true ] ]]. - - [PushCw] -> [^(self inCurrentCompilation: (operands at: 0)) not]. - [PushCq] -> [^self shiftable16bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]]. - [PrefetchAw] -> [^(self isAddressRelativeToVarBase: (operands at: 0)) ifTrue: [false] ifFalse: [true]]. - - "Patcheable instruction. Moves a literal. Uses out of line literal." - [MovePatcheableC32R] -> [ ^ true ] - } - otherwise: [self error: 'We should not be here!!!']. - ^false "to keep C compiler quiet" - + ([ CallFull ] -> [ ^ true ]). + ([ JumpFull ] -> [ ^ true ]). + "Arithmetic" + ([ AddCqR ] -> [ + | constant | + constant := operands at: 0. + ^ (constant abs bitAnd: 16rfff) ~= constant abs ]). + ([ AndCqR ] -> [ + ^ self + encodeLogicalImmediate: (operands at: 0) + registerSize: 64 + ifPossible: [ :value | false ] + ifNotPossible: [ true ] ]). + ([ AndCqRR ] -> [ + ^ self + encodeLogicalImmediate: (operands at: 0) + registerSize: 64 + ifPossible: [ :value | false ] + ifNotPossible: [ true ] ]). + ([ CmpCqR ] -> [ + ((operands at: 0) abs bitAnd: 16rFFF) = (operands at: 0) abs + ifTrue: [ ^ false ]. + ((operands at: 0) abs << 12 >> 12 bitAnd: 16rFFF) + = (operands at: 0) abs ifTrue: [ ^ false ]. + ^ true ]). + ([ CmpC32R ] -> [ + ^ self + rotateable8bitSignedImmediate: (operands at: 0) + ifTrue: [ :r :i :n | false ] + ifFalse: [ true ] ]). + ([ OrCqR ] -> [ + ^ self + encodeLogicalImmediate: (operands at: 0) + registerSize: 64 + ifPossible: [ :v | false ] + ifNotPossible: [ true ] ]). + + ([ SubCqR ] -> [ + | constant | + constant := operands at: 0. + ^ (constant bitAnd: 16rfff) ~= constant ]). + ([ TstCqR ] -> [ + ^ self + encodeLogicalImmediate: (operands at: 0) + registerSize: 64 + ifPossible: [ :v | false ] + ifNotPossible: [ true ] ]). + ([ XorCqR ] -> [ + ^ self + rotateable8bitBitwiseImmediate: (operands at: 0) + ifTrue: [ :r :i :n | false ] + ifFalse: [ true ] ]). + ([ AddCwR ] -> [ ^ true ]). + ([ AndCwR ] -> [ ^ true ]). + ([ CmpCwR ] -> [ ^ true ]). + ([ OrCwR ] -> [ ^ true ]). + ([ SubCwR ] -> [ ^ true ]). + ([ XorCwR ] -> [ ^ true ]). + ([ LoadEffectiveAddressMwrR ] -> [ + ^ self + rotateable8bitImmediate: (operands at: 0) + ifTrue: [ :r :i | false ] + ifFalse: [ true ] ]). + "Data Movement" + ([ MoveCqR ] -> [ + | quickConstant | + quickConstant := operands at: 0. + ^ (quickConstant < 0 and: [ + (self isShiftable16bitImmediate: quickConstant negated - 1) + not ]) or: [ + (self isShiftable16bitImmediate: quickConstant) not ] ]). + ([ MoveC32R ] -> [ + | quickConstant | + quickConstant := operands at: 0. + ^ (quickConstant < 0 and: [ + (self isShiftable16bitImmediate: quickConstant negated - 1) + not ]) or: [ + (self isShiftable16bitImmediate: quickConstant) not ] ]). + + ([ MoveCwR ] + -> [ ^ (self inCurrentCompilation: (operands at: 0)) not ]). + ([ MoveAwR ] -> [ + ^ (self isAddressRelativeToVarBase: (operands at: 0)) + ifTrue: [ false ] + ifFalse: [ true ] ]). + ([ MoveRAw ] -> [ + ^ (self isAddressRelativeToVarBase: (operands at: 1)) + ifTrue: [ false ] + ifFalse: [ true ] ]). + ([ MoveAbR ] -> [ + ^ (self isAddressRelativeToVarBase: (operands at: 0)) + ifTrue: [ false ] + ifFalse: [ true ] ]). + ([ MoveRAb ] -> [ + ^ (self isAddressRelativeToVarBase: (operands at: 1)) + ifTrue: [ false ] + ifFalse: [ true ] ]). + + + ([ MoveRM32r ] -> [ + self + is9BitValue: (operands at: 1) + ifTrue: [ :value | ^ false ] + ifFalse: [ + self + shiftable16bitImmediate: (operands at: 1) + ifTrue: [ :value :shift | ^ false ] + ifFalse: [ ^ true ] ] ]). + + ([ MoveRMwr ] -> [ + self + is9BitValue: (operands at: 1) + ifTrue: [ :value | ^ false ] + ifFalse: [ + self + shiftable16bitImmediate: (operands at: 1) + ifTrue: [ :value :shift | ^ false ] + ifFalse: [ ^ true ] ] ]). + + ([ MoveRsM32r ] -> [ + ^ self + is12BitValue: (operands at: 1) + ifTrue: [ :s :v | false ] + ifFalse: [ true ] ]). + ([ MoveRdM64r ] -> [ + ^ self + is12BitValue: (operands at: 1) + ifTrue: [ :s :v | false ] + ifFalse: [ true ] ]). + ([ MoveMbrR ] -> [ + ^ self + is9BitValue: (operands at: 0) + ifTrue: [ :v | false ] + ifFalse: [ true ] ]). + ([ MoveRMbr ] -> [ + ^ self + is12BitValue: (operands at: 1) + ifTrue: [ :s :v | false ] + ifFalse: [ true ] ]). + ([ MoveRM8r ] -> [ + ^ self + is12BitValue: (operands at: 1) + ifTrue: [ :s :v | false ] + ifFalse: [ true ] ]). + ([ MoveM16rR ] -> [ + ^ self + rotateable8bitImmediate: (operands at: 0) + ifTrue: [ :r :i | false ] + ifFalse: [ true ] ]). + ([ MoveRM16r ] -> [ + ^ self + is12BitValue: (operands at: 1) + ifTrue: [ :s :v | false ] + ifFalse: [ true ] ]). + ([ MoveM32rRs ] -> [ + ^ self + is12BitValue: (operands at: 0) + ifTrue: [ :s :v | false ] + ifFalse: [ true ] ]). + ([ MoveM64rRd ] -> [ + ^ self + is12BitValue: (operands at: 0) + ifTrue: [ :s :v | false ] + ifFalse: [ true ] ]). + + ([ MoveM32rR ] -> [ + offset := operands at: 0. + (offset >= 0 and: [ (offset bitAnd: 16rFFF) = offset ]) + ifTrue: [ ^ false ] + ifFalse: [ + self + is9BitValue: offset + ifTrue: [ :v | ^ false ] + ifFalse: [ ^ true ] ] ]). + + ([ MoveMwrR ] -> [ + offset := operands at: 0. + (offset >= 0 and: [ (offset bitAnd: 16rFFF) = offset ]) + ifTrue: [ ^ false ] + ifFalse: [ + self + is9BitValue: offset + ifTrue: [ :v | ^ false ] + ifFalse: [ ^ true ] ] ]). + + ([ PushCw ] + -> [ ^ (self inCurrentCompilation: (operands at: 0)) not ]). + ([ PushCq ] -> [ + ^ self + shiftable16bitImmediate: (operands at: 0) + ifTrue: [ :r :i | false ] + ifFalse: [ true ] ]). + ([ PrefetchAw ] -> [ + ^ (self isAddressRelativeToVarBase: (operands at: 0)) + ifTrue: [ false ] + ifFalse: [ true ] ]). + + "Patcheable instruction. Moves a literal. Uses out of line literal." + ([ MovePatcheableC32R ] -> [ ^ true ]) } + otherwise: [ self error: 'We should not be here!!!' ]. + ^ false "to keep C compiler quiet" ]