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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.1992
Author: eem
Time: 14 November 2016, 3:20:23.186309 pm
UUID: 6feb3008-c996-4d53-b572-55c31a5b58dc
Ancestors: VMMaker.oscog-nice.1991

Fix integerValueOf: & integerObjectOf: in plugins for 64-bits.  Since the CCodeGenerator generates the shifts directly it must use a #define for the number of tag bits to shift by since in 64-bit Spur we use three tag bits, not one.

Simulator:

Revert changes to SpurNBitMemoryManager>>integerValueOf: which use bitShift: for simulation.

Fix coercions for usqIntptr_t (*)(void).

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

Item was changed:
  ----- Method: CogClass>>cCoerceSimple:to: (in category 'translation support') -----
  cCoerceSimple: value to: cTypeString
  	<doNotGenerate>
  	"Type coercion for translation and simulation.
  	 For simulation answer a suitable surrogate for the struct types"
  	^cTypeString caseOf:
  	   {	[#'unsigned long']							->	[value].
  		[#'unsigned int']							->	[value].
  		[#sqInt]										->	[value].
  		[#'sqIntptr_t']								->	[value].
  		[#'usqIntptr_t']								->	[value].
  		[#usqInt]									->	[value].
  		[#sqLong]									->	[value].
  		[#usqLong]									->	[value].
  		[#'AbstractInstruction *']					->	[value].
  		[#'BytecodeFixup *']						->	[value].
  		[#'CogMethod *']							->	[value].
  		[#'char *']									->	[value].
  		[#'sqInt *']									->	[value].
  		[#'void *']									->	[value].
  		[#void]										->	[value].
  		[#'void (*)()']								->	[value].
  		[#'void (*)(void)']							->	[value].
  		[#'unsigned long (*)(void)']					->	[value].
+ 		[#'void (*)(unsigned long,unsigned long)']	->	[value].
+ 		[#'usqIntptr_t (*)(void)']					->	[value] }!
- 		[#'void (*)(unsigned long,unsigned long)']	->	[value] }!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>integerValueOf: (in category 'immediates') -----
  integerValueOf: oop
  	"Translator produces 'oop >> 1'"
+ 	^(oop bitShift: -31) = 1 "tests top bit"
- 	^(oop >> 31) = 1 "tests top bit"
  		ifTrue: "negative"
+ 			[((oop bitShift: -1) bitAnd: 16r3FFFFFFF) - 16r3FFFFFFF - 1  "Faster than -16r40000000 (a LgInt)"]
- 			[((oop >> 1) bitAnd: 16r3FFFFFFF) - 16r3FFFFFFF - 1  "Faster than -16r40000000 (a LgInt)"]
  		ifFalse: "positive"
+ 			[oop bitShift: -1]!
- 			[oop >> 1]!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>integerValueOf: (in category 'immediates') -----
  integerValueOf: oop
  	"Translator produces 'oop >> 3'"
+ 	^(oop bitShift: -63) = 1 "tests top bit"
- 	^(oop >> 63) = 1 "tests top bit"
  		ifTrue: "negative"
+ 			[((oop bitShift: self numTagBits negated) bitAnd: 16r1FFFFFFFFFFFFFFF) - 16r1FFFFFFFFFFFFFFF - 1  "Faster than -16r4000000000000000 (a LgInt)"]
- 			[((oop >> self numTagBits) bitAnd: 16r1FFFFFFFFFFFFFFF) - 16r1FFFFFFFFFFFFFFF - 1  "Faster than -16r4000000000000000 (a LgInt)"]
  		ifFalse: "positive"
+ 			[oop bitShift: self numTagBits negated]!
- 			[oop >> self numTagBits]!

Item was changed:
  ----- Method: VMClass class>>writeVMHeaderTo:bytesPerWord: (in category 'translation') -----
  writeVMHeaderTo: aStream bytesPerWord: bytesPerWord
  	"Generate the contents of interp.h on aStream.  Specific Interpreter subclasses
  	 override to add more stuff."
  	aStream
  		nextPutAll: '#define VM_PROXY_MAJOR '; print: self vmProxyMajorVersion; cr;
  		nextPutAll: '#define VM_PROXY_MINOR '; print: self vmProxyMinorVersion; cr;
  		cr;
  		nextPutAll: '#define SQ_VI_BYTES_PER_WORD '; print: bytesPerWord; cr;
  		cr.
  
  	"The most basic constants must be defined here, not in e.g. the plugin sources, so allow those
  	 other sources to be shared between different builds (Spur vs SqueakV3, 32-bit vs 64-bit, etc)"
  	VMBasicConstants mostBasicConstantNames asSet asArray sort do:
  		[:constName|
  		(VMBasicConstants classPool at: constName ifAbsent: []) ifNotNil:
  			[:const|
  			aStream nextPutAll: '#define '; nextPutAll: constName; space; print: const; cr]].
  	aStream cr.
  
  	((VMBasicConstants classPool associations select: [:a| a key beginsWith: 'PrimErr'])
  		asSortedCollection: [:a1 :a2| a1 value <= a2 value])
  		do: [:a|
  			aStream nextPutAll: '#define '; nextPutAll: a key; space; print: a value; cr].
  	aStream cr.
  
  	aStream
  		nextPutAll: '#define MinSmallInteger '; print: self objectMemoryClass minSmallInteger; cr;
  		nextPutAll: '#define MaxSmallInteger '; print: self objectMemoryClass maxSmallInteger; cr;
+ 		nextPutAll: '#define NumSmallIntegerTagBits '; print: self objectMemoryClass numSmallIntegerTagBits; cr;
  		cr.!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>generateIntegerObjectOf:on:indent: (in category 'C translation') -----
+ generateIntegerObjectOf: msgNode on: aStream indent: level
+ 	"Generate the C code for this message onto the given stream."
+ 	| expr mustCastToUnsigned type typeIsUnsigned |
+ 	expr := msgNode args first.
+ 	aStream nextPutAll: '(('.
+ 	"Note that the default type of an integer constant in C is int.  Hence we /must/
+ 	 cast expression to long if in the 64-bit world, since e.g. in 64-bits
+ 		(int)(16r1FFFFF << 3) = (int)16rFFFFFFF8 = -8
+ 	 whereas
+ 		(long)(16r1FFFFF << 3) = (long)16rFFFFFFF8 = 4294967288."
+ 	type := self typeFor: expr in: currentMethod.
+ 	typeIsUnsigned := type first = $u.
+ 	mustCastToUnsigned := typeIsUnsigned not
+ 							  or: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
+ 	mustCastToUnsigned ifTrue:
+ 		[aStream nextPutAll: '(usqInt)'].
+ 	self emitCExpression: expr on: aStream.
+ 	aStream nextPutAll: ' << NumSmallIntegerTagBits) | 1)'!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>generateIntegerValueOf:on:indent: (in category 'C translation') -----
+ generateIntegerValueOf: msgNode on: aStream indent: level
+ 	"Generate the C code for this message onto the given stream."
+ 
+ 	aStream nextPut: $(.
+ 	self emitCExpression: msgNode args first on: aStream.
+ 	aStream nextPutAll: ' >> NumSmallIntegerTagBits)'!