[Vm-dev] VM Maker: VMMaker.oscog-nice.2913.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Dec 29 13:35:25 UTC 2020


Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.2913.mcz

==================== Summary ====================

Name: VMMaker.oscog-nice.2913
Author: nice
Time: 29 December 2020, 2:35:15.410054 pm
UUID: 7424bace-30d6-4cff-87e5-8bed5d7709fc
Ancestors: VMMaker.oscog-nice.2910

Complexify the rule for generating hex literal constants when more intellegible than decimal.

This is useful for having a chance to decipher generated code for bit tricks.

Document the intended behavior with a small test.

This replaces VMMaker.oscog-nice.2912 that screwed things up (had a copy/paste bug).
VMMaker.oscog-nice.2912 should be thrown away as well as previus attempt VMMaker.oscog-nice.2911

=============== Diff against VMMaker.oscog-nice.2910 ===============

Item was changed:
  ----- Method: CCodeGenerator>>cLiteralFor: (in category 'C code generator') -----
  cLiteralFor: anObject
  	"Return a string representing the C literal value for the given object."
+ 		
  	anObject isNumber
  		ifTrue:
  			[anObject isInteger ifTrue:
+ 				[| hex dec useHexa |
+ 				 hex := anObject printStringBase: 16.
+ 				 dec := anObject printStringBase: 10.
+ 				 useHexa := (anObject > 255
+ 								and: [(hex asSet size * 3) <= (dec asSet size * 2)
+ 									or: [((hex as: RunArray) runs size * 4) < ((dec as: RunArray) runs size * 3)]])
+ 					or: [anObject > 0
- 				[| hex |
- 				 hex := (anObject > 0
  								and: [(anObject >> anObject lowBit + 1) isPowerOfTwo
  								and: [(anObject highBit = anObject lowBit and: [anObject > 65536])
+ 									  or: [anObject highBit - anObject lowBit >= 4]]]].
+ 				^self cLiteralForInteger: anObject hex: useHexa].
- 									  or: [anObject highBit - anObject lowBit >= 4]]]).
- 				^self cLiteralForInteger: anObject hex: hex].
  			anObject isFloat ifTrue:
  				[^anObject printString]]
  		ifFalse:
  			[anObject isSymbol ifTrue:
  				[^self cFunctionNameFor: anObject].
  			anObject isString ifTrue:
  				[^'"', (anObject copyReplaceAll: (String with: Character cr) with: '\n') , '"'].
  			anObject == nil ifTrue: [^ 'null' ].
  			anObject == true ifTrue: [^ '1' ].
  			anObject == false ifTrue: [^ '0' ].
  			anObject isCharacter ifTrue:
  				[^anObject == $'
  					ifTrue: ['''\'''''] "i.e. '\''"
  					ifFalse: [anObject asString printString]]].
  	self error: 'Warning: A Smalltalk literal could not be translated into a C constant: ', anObject printString.
  	^'"XXX UNTRANSLATABLE CONSTANT XXX"'!

Item was changed:
  ----- Method: CCodeGeneratorTests>>testIntegerGeneration (in category 'tests') -----
  testIntegerGeneration
  
+ 	"Test the 32-bit integers. They need to be marked as unsigned.
- 	"Test the 32-bit integers. They need to be marked as unsigned longs.
  	 Test 16rFFFFFFFF, 16rFFFFFFFE, ... through to ..., 16rC0000000, 16r80000000"
  	((0 to: 31) collect: [:shift| 16rFFFFFFFF bitClear: (1 bitShift: shift) - 1]) do:
+ 		[:number| | literal isHex isDec |
- 		[:number| | literal |
  		literal := self cg cLiteralFor: number.
+ 		isHex := (literal beginsWith: '0x') and: [((literal allButFirst: 2) allButLast: 1) allSatisfy: [:c| '0123456789CEF' includes: c]].
+ 		isDec := (literal allButLast: 1) allSatisfy: [:c| c isDigit].
+ 		self assert: isHex | isDec.
+ 		self assert: (literal endsWith: 'U').
- 		self assert: ((literal allButLast: 2) allSatisfy: [:c| c isDigit]).
- 		self assert: (literal endsWith: 'UL').
  
  		literal := self cg cLiteralFor: number name: 'Mask'.
  		self assert: (literal beginsWith: '0x').
+ 		self assert: (((literal allButFirst: 2) allButLast: 1) allSatisfy: [:c| '0123456789CEF' includes: c]).
+ 		self assert: (literal endsWith: 'U')].
- 		self assert: (((literal allButFirst: 2) allButLast: 2) allSatisfy: [:c| '0123456789CEF' includes: c]).
- 		self assert: (literal endsWith: 'UL')].
  
  	"Test the 64-bit integers. They need to be marked as unsigned long longs."
  	((32 to: 63) collect: [:shift| 16rFFFFFFFFFFFFFFFF bitClear: (1 bitShift: shift) - 1]) do:
+ 		[:number| | literal isHex isDec |
- 		[:number| | literal |
  		literal := self cg cLiteralFor: number.
+ 		isHex := (literal beginsWith: '0x') and: [((literal allButFirst: 2) allButLast: 3) allSatisfy: [:c| '0123456789CEF' includes: c]].
+ 		isDec := (literal allButLast: 3) allSatisfy: [:c| c isDigit].
+ 		self assert: isHex | isDec.
- 		self assert: ((literal allButLast: 3) allSatisfy: [:c| c isDigit]).
  		self assert: (literal endsWith: 'ULL').
  
  		literal := self cg cLiteralFor: number name: 'Mask'.
  		self assert: (literal beginsWith: '0x').
  		self assert: (((literal allButFirst: 2) allButLast: 3) allSatisfy: [:c| '0123456789CEF' includes: c]).
  		self assert: (literal endsWith: 'ULL')]!

Item was added:
+ ----- Method: CCodeGeneratorTests>>testIntegerGenerationHexOrDec (in category 'tests') -----
+ testIntegerGenerationHexOrDec
+ 	| decPrefered hexPrefered |
+ 	hexPrefered := #(
+ 			16r100 16r400 16r10000 "powers of two (more than 8 bits)"
+ 			16r1F 16r3FF 16rFFFF "powers of two minus 1 - with at least 5 bits set"
+ 			16r3E 16r3FF00 16r1FE0  "shifted powers of two minus 1 - wih at least 5 bit set..."
+ 			16r38000 "... or having highBit >= 16"
+ 			16rC00 "... or requiring 1.5 times less different characters than decimal form - here 2 instead of 4"
+ 			16r1F1F 16rCCCC  16r112233 "some regular bit patterns"
+ 			2r111000111000111000111 "not necessarily falling on 4 bits boundaries"
+ 			).
+ 	decPrefered := #(
+ 			0 1 2 3 4 5 6 7 8 9 "single digit"
+ 			10 100 1000 10000 "powers of ten"
+ 			9 99 999 9999 "powers of ten minus 1"
+ 			16r10 16r20 16r40 16r80 "small powers of two"
+ 			16r60 16rC0 16rF0  16r1E00 "shifted powers of two minus 1 - with less than 5 bits set"
+ 			112233 15341 "random patterns when no hex rule apply"
+ 			2r1111100000111110000011111000001111100000 "regular bit pattern if the decimal form appear somehow also regular -  here it uses a pattern of only 4 different digits : 1066193093600").
+ 	hexPrefered do: [:number || literal |
+ 		literal := self cg cLiteralFor: number.
+ 		self assert: (literal beginsWith: '0x')].
+ 	decPrefered do: [:number || literal |
+ 		literal := self cg cLiteralFor: number.
+ 		self deny: (literal beginsWith: '0x')].!

Item was changed:
  ----- Method: SlangTests>>testSimpleMethod (in category 'tests') -----
  testSimpleMethod
  	| codeGenerator tMethod code |
  	codeGenerator := CCodeGenerator new.
  	tMethod := codeGenerator compileToTMethodSelector: #extBBytecode in: StackInterpreter.
  	self assert: #(	#'['
  					byte #':=' self fetchByte #'.'
  					self fetchNextBytecode #'.'
  					extB #':=' #(numExtB #= 0 and: #'[' byte #> 127 #']')
  									ifTrue: #'[' byte #- 256 #']'
  									ifFalse: #'[' #(extB bitShift: 8) #+ byte #']' #'.'
  					numExtB #':=' numExtB #+ 1 #'.'
  					#'^' self
  					#']')
  		equals: (Scanner new scanTokens: tMethod parseTree printString).
  	code := String streamContents: [:s| tMethod emitCCodeOn: s generator: codeGenerator].
  	code := code allButFirst: (code indexOfSubCollection: 'sqInt') - 1.
  	self assert:  #('sqInt' 'extBBytecode(void)' '{' 'sqInt' 'byte;'
  					'byte' '=' 'fetchByte();'
  					'fetchNextBytecode();'
  					'extB' '=' '((numExtB' '==' '0)' '&&' '(byte' '>' '0x7F)'
+ 						'?' 'byte' '-' '0x100'
+ 						':' '((((sqInt)((usqInt)(extB)' '<<' '8))))' '+' 'byte);'
- 						'?' 'byte' '-' '256'
- 						':' '(((usqInt)' 'extB' '<<' '8))' '+' 'byte);'
  					'numExtB' '+=' '1;' 'return' 'self;' '}')
  		equals: (code findTokens: Character separators) asArray !



More information about the Vm-dev mailing list