[Vm-dev] VM Maker: VMMaker.oscog-eem.243.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Jan 2 19:37:17 UTC 2013


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.243.mcz

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

Name: VMMaker.oscog-eem.243
Author: eem
Time: 2 January 2013, 11:34:09.193 am
UUID: 72a4a123-e10e-4d32-90dd-0b74014f02d3
Ancestors: VMMaker.oscog-eem.242

Integrate issue 112.  Add ULL suffix to > 32 bit integer literals.
Add a test for integer literal generation (doesn't yet test negative
values).

=============== Diff against VMMaker.oscog-eem.242 ===============

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:
+ 				[^anObject > 16rFFFFFFFF
+ 						ifTrue: [anObject printString , ObjectMemory unsignedLongLongSuffix]
+ 						ifFalse: [anObject < 16r7FFFFFFF
+ 							ifTrue: [anObject printString]
+ 							ifFalse: [anObject printString , ObjectMemory unsignedIntegerSuffix]]].
- 				[^(anObject < 16r7FFFFFFF)
- 					ifTrue: [anObject printString]
- 					ifFalse: [anObject printString , ObjectMemory unsignedIntegerSuffix]].
  			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: CCodeGenerator>>cLiteralFor:name: (in category 'C code generator') -----
  cLiteralFor: anObject name: smalltalkName
  	"Return a string representing the C literal value for the given object.
  	 This version may use hex for integers that are bit masks."
  	anObject isInteger ifTrue:
  		[| hex dec rep |
  		hex := anObject printStringBase: 16.
  		dec := anObject printStringBase: 10.
  		rep := ((smalltalkName endsWith: 'Mask')
  				or: [anObject digitLength > 1
  					and: [(hex asSet size * 3) <= (dec asSet size * 2)
  					and: [(smalltalkName endsWith: 'Size') not]]])
  					ifTrue: [hex first = $- ifTrue: ['-0x', hex allButFirst] ifFalse: ['0x', hex]]
  					ifFalse: [dec].
+ 		^anObject > 16rFFFFFFFF
+ 			ifTrue: [rep, ObjectMemory unsignedLongLongSuffix]
+ 			ifFalse: [anObject < 16r7FFFFFFF
+ 				ifTrue: [rep]
+ 				ifFalse: [rep, ObjectMemory unsignedIntegerSuffix]]].
- 		^(anObject < 16r7FFFFFFF)
- 			ifTrue: [rep]
- 			ifFalse: [rep, ObjectMemory unsignedIntegerSuffix "ikp"]].
  	^self cLiteralFor: anObject!

Item was added:
+ TestCase subclass: #CCodeGeneratorTests
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Tests'!

Item was added:
+ ----- Method: CCodeGeneratorTests>>cg (in category 'private') -----
+ cg
+ 	^CCodeGenerator new!

Item was added:
+ ----- Method: CCodeGeneratorTests>>testIntegerGeneration (in category 'tests') -----
+ testIntegerGeneration
+ 
+ 	"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 |
+ 		literal := self cg cLiteralFor: number.
+ 		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: 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: 64) collect: [:shift| 16rFFFFFFFFFFFFFFFF bitClear: (1 bitShift: shift) - 1]) do:
+ 		[:number| | literal |
+ 		literal := self cg cLiteralFor: number.
+ 		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: ObjectMemory class>>unsignedLongLongSuffix (in category 'translation') -----
+ unsignedLongLongSuffix
+ 	"Answer the suffix that should be appended to unsigned integer literals in generated code."
+ 
+ 	^'ULL'!



More information about the Vm-dev mailing list