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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 10 21:52:16 UTC 2013


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

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

Name: VMMaker.oscog-eem.363
Author: eem
Time: 10 September 2013, 2:49:34.108 pm
UUID: aa44129c-c899-45d7-a314-f545a91cbdde
Ancestors: VMMaker.oscog-eem.362

Implement eeInstantiateClassIndex:format:numSlots: for
ObjectMemory and use it in float, large integer and (if possible)
closure creation.

Eliminate bytesPerWord in favour of wordSize (Smalltalk wordSize is
the model here).  wordSize is shorter.  However, still generate
BytesPerWord for wordSize since e.g. mpegtype.h has a parameter
named WordSize.

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

Item was changed:
  ----- Method: CCodeGenerator>>generateBytesPerWord:on:indent: (in category 'C translation') -----
  generateBytesPerWord: msgNode on: aStream indent: level
+ 	"Generate the C code for this message onto the given stream.
+ 	 Would prefer to use WordSize than BytesPerWord (shorter) but e.g.
+ 	 mpegtype.h has a parameter named WordSize."
- 	"Generate the C code for this message onto the given stream."
  
  	aStream nextPutAll: 'BytesPerWord'!

Item was changed:
  ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') -----
  initializeCTranslationDictionary 
  	"Initialize the dictionary mapping message names to actions for C code generation."
  
  	| pairs |
  	
  	translationDict := Dictionary new: 200.
  	pairs := #(
  	#&				#generateAnd:on:indent:
  	#|				#generateOr:on:indent:
  	#and:			#generateSequentialAnd:on:indent:
  	#or:			#generateSequentialOr:on:indent:
  	#not			#generateNot:on:indent:
  
  	#+				#generatePlus:on:indent:
  	#-				#generateMinus:on:indent:
  	#negated		#generateNegated:on:indent:
  	#*				#generateTimes:on:indent:
  	#/				#generateDivide:on:indent:
  	#//				#generateDivide:on:indent:
  	#\\				#generateModulo:on:indent:
  	#<<			#generateShiftLeft:on:indent:
  	#>>			#generateShiftRight:on:indent:
  	#min:			#generateMin:on:indent:
  	#max:			#generateMax:on:indent:
  	#between:and:	#generateBetweenAnd:on:indent:
  
  	#bitAnd:			#generateBitAnd:on:indent:
  	#bitOr:				#generateBitOr:on:indent:
  	#bitXor:			#generateBitXor:on:indent:
  	#bitShift:			#generateBitShift:on:indent:
  	#signedBitShift:	#generateSignedBitShift:on:indent:
  	#bitInvert32		#generateBitInvert32:on:indent:
  	#bitClear:			#generateBitClear:on:indent:
  
  	#<				#generateLessThan:on:indent:
  	#<=			#generateLessThanOrEqual:on:indent:
  	#=				#generateEqual:on:indent:
  	#>				#generateGreaterThan:on:indent:
  	#>=			#generateGreaterThanOrEqual:on:indent:
  	#~=			#generateNotEqual:on:indent:
  	#==			#generateEqual:on:indent:
  	#~~			#generateNotEqual:on:indent:
  	#isNil			#generateIsNil:on:indent:
  	#notNil			#generateNotNil:on:indent:
  
  	#whileTrue: 	#generateWhileTrue:on:indent:
  	#whileFalse:	#generateWhileFalse:on:indent:
  	#whileTrue 	#generateDoWhileTrue:on:indent:
  	#whileFalse		#generateDoWhileFalse:on:indent:
  	#to:do:			#generateToDo:on:indent:
  	#to:by:do:		#generateToByDo:on:indent:
  	#repeat 		#generateRepeat:on:indent:
  
  	#ifTrue:			#generateIfTrue:on:indent:
  	#ifFalse:		#generateIfFalse:on:indent:
  	#ifTrue:ifFalse:	#generateIfTrueIfFalse:on:indent:
  	#ifFalse:ifTrue:	#generateIfFalseIfTrue:on:indent:
  
  	#ifNotNil:		#generateIfNotNil:on:indent:
  	#ifNil:			#generateIfNil:on:indent:
  	#ifNotNil:ifNil:	#generateIfNotNilIfNil:on:indent:
  	#ifNil:ifNotNil:	#generateIfNilIfNotNil:on:indent:
  
  	#at:				#generateAt:on:indent:
  	#at:put:			#generateAtPut:on:indent:
  	#basicAt:		#generateAt:on:indent:
  	#basicAt:put:	#generateAtPut:on:indent:
  
  	#integerValueOf:			#generateIntegerValueOf:on:indent:
  	#integerObjectOf:			#generateIntegerObjectOf:on:indent:
  	#isIntegerObject: 			#generateIsIntegerObject:on:indent:
  	#cCode:					#generateInlineCCode:on:indent:
  	#cCode:inSmalltalk:			#generateInlineCCode:on:indent:
  	#cPreprocessorDirective:	#generateInlineCPreprocessorDirective:on:indent:
  	#cppIf:ifTrue:ifFalse:		#generateInlineCppIfElse:on:indent:
  	#cppIf:ifTrue:				#generateInlineCppIfElse:on:indent:
  	#cCoerce:to:				#generateCCoercion:on:indent:
  	#cCoerceSimple:to:			#generateCCoercion:on:indent:
  	#addressOf:				#generateAddressOf:on:indent:
  	#signedIntFromLong		#generateSignedIntFromLong:on:indent:
  	#signedIntToLong			#generateSignedIntToLong:on:indent:
  	#signedIntFromShort		#generateSignedIntFromShort:on:indent:
  	#signedIntToShort			#generateSignedIntToShort:on:indent:
  	#preIncrement				#generatePreIncrement:on:indent:
  	#preDecrement			#generatePreDecrement:on:indent:
  	#inline:						#generateInlineDirective:on:indent:
  	#asFloat					#generateAsFloat:on:indent:
  	#asInteger					#generateAsInteger:on:indent:
  	#asUnsignedInteger		#generateAsUnsignedInteger:on:indent:
  	#asLong					#generateAsLong:on:indent:
  	#asUnsignedLong			#generateAsUnsignedLong:on:indent:
  	#asSymbol					#generateAsSymbol:on:indent:
  	#flag:						#generateFlag:on:indent:
  	#anyMask:					#generateBitAnd:on:indent:
  	#raisedTo:					#generateRaisedTo:on:indent:
  	#touch:						#generateTouch:on:indent:
  
  	#bytesPerWord 			#generateBytesPerWord:on:indent:
+ 	#wordSize		 			#generateBytesPerWord:on:indent:
  	#baseHeaderSize			#generateBaseHeaderSize:on:indent:
  	
  	#sharedCodeNamed:inCase:		#generateSharedCodeDirective:on:indent:
  
  	#perform:							#generatePerform:on:indent:
  	#perform:with:						#generatePerform:on:indent:
  	#perform:with:with:					#generatePerform:on:indent:
  	#perform:with:with:with:				#generatePerform:on:indent:
  	#perform:with:with:with:with:		#generatePerform:on:indent:
  	#perform:with:with:with:with:with:	#generatePerform:on:indent:
  
  	#value								#generateValue:on:indent:
  	#value:								#generateValue:on:indent:
  	#value:value:						#generateValue:on:indent:
  
  	#shouldNotImplement				#generateSmalltalkMetaError:on:indent:
  	#shouldBeImplemented			#generateSmalltalkMetaError:on:indent:
  	).
  
  	1 to: pairs size by: 2 do: [:i |
  		translationDict at: (pairs at: i) put: (pairs at: i + 1)].
  
  	pairs := #(
  	#ifTrue:					#generateIfTrueAsArgument:on:indent:	
  	#ifFalse:				#generateIfFalseAsArgument:on:indent:
  	#ifTrue:ifFalse:			#generateIfTrueIfFalseAsArgument:on:indent:
  	#ifFalse:ifTrue:			#generateIfFalseIfTrueAsArgument:on:indent:
  	#ifNotNil:				#generateIfNotNilAsArgument:on:indent:	
  	#ifNil:					#generateIfNilAsArgument:on:indent:
  	#ifNotNil:ifNil:			#generateIfNotNilIfNilAsArgument:on:indent:
  	#ifNil:ifNotNil:			#generateIfNilIfNotNilAsArgument:on:indent:
  	#cCode:				#generateInlineCCodeAsArgument:on:indent:
  	#cCode:inSmalltalk:		#generateInlineCCodeAsArgument:on:indent:
  	#cppIf:ifTrue:ifFalse:	#generateInlineCppIfElseAsArgument:on:indent:
  	#cppIf:ifTrue:			#generateInlineCppIfElseAsArgument:on:indent:
  	).
  
  	asArgumentTranslationDict := Dictionary new: 8.
  	1 to: pairs size by: 2 do: [:i |
  		asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
  !

Item was changed:
  ----- Method: CoInterpreterStackPagesMSB>>byteAt: (in category 'memory access') -----
  byteAt: byteAddress
  	| lowBits bpwMinus1 |
+ 	bpwMinus1 := objectMemory wordSize - 1.
- 	bpwMinus1 := StackInterpreter bytesPerWord - 1.
  	lowBits := byteAddress bitAnd: bpwMinus1.
  	^((self longAt: byteAddress - lowBits)
  		bitShift: (lowBits - bpwMinus1) * 8)
  		bitAnd: 16rFF!

Item was removed:
- ----- Method: InterpreterSimulatorLSB64>>bytesPerWord (in category 'memory access') -----
- bytesPerWord
- 	"overridden for 64-bit images..."
- 
- 	^ 8!

Item was added:
+ ----- Method: InterpreterSimulatorLSB64>>wordSize (in category 'memory access') -----
+ wordSize
+ 	"overridden for 64-bit images..."
+ 
+ 	^8!

Item was removed:
- ----- Method: InterpreterSimulatorMSB64>>bytesPerWord (in category 'memory access') -----
- bytesPerWord
- 	"overridden for 64-bit images..."
- 
- 	^ 8!

Item was added:
+ ----- Method: InterpreterSimulatorMSB64>>wordSize (in category 'memory access') -----
+ wordSize
+ 	"overridden for 64-bit images..."
+ 
+ 	^8!

Item was changed:
  ----- Method: InterpreterStackPagesMSB>>byteAt: (in category 'memory access') -----
  byteAt: byteAddress
  	| lowBits bpwMinus1 |
+ 	bpwMinus1 := StackInterpreter wordSize - 1.
- 	bpwMinus1 := StackInterpreter bytesPerWord - 1.
  	lowBits := byteAddress bitAnd: bpwMinus1.
  	^((self longAt: byteAddress - lowBits)
  		bitShift: (lowBits - bpwMinus1) * 8)
  		bitAnd: 16rFF!

Item was added:
+ ----- Method: NewObjectMemory>>eeInstantiateClassIndex:format:numSlots: (in category 'interpreter access') -----
+ eeInstantiateClassIndex: compactClassIndex format: objFormat numSlots: numSlots
+ 	"Instantiate an instance of a compact class.  ee stands for execution engine and
+ 	 implies that this allocation will *NOT* cause a GC.  N.B. the instantiated object
+ 	 IS NOT FILLED and must be completed before returning it to Smalltalk. Since this
+ 	 call is used in routines that do just that we are safe.  Break this rule and die in GC."
+ 	<api>
+ 	| hash header1 header2 byteSize header3 hdrSize |
+ 	<inline: false>
+ 	"cannot have a negative indexable field count"
+ 	self assert: (numSlots > 0 and: [compactClassIndex ~= 0]).
+ 	self assert: (objFormat < self firstByteFormat
+ 					ifTrue: [objFormat]
+ 					ifFalse: [objFormat bitAnd: self byteFormatMask])
+ 				= (self instSpecOfClass: (self compactClassAt: compactClassIndex)).
+ 	hash := self newObjectHash.
+ 	"Low 2 bits are 0"
+ 	header1 := (objFormat << self instFormatFieldLSB
+ 					bitOr: compactClassIndex << 12)
+ 					bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
+ 	self assert: "sizeHiBits" ((self formatOfClass: (self compactClassAt: compactClassIndex)) bitAnd: 16r60000) >> 9 = 0.
+ 	self flag: #sizeLowBits.
+ 	"size in bytes -- low 2 bits are 0; may need another shift if 64-bits.
+ 	 strangely, size includes size of header, but only of single header.
+ 	 why include header size at all?  gives us an extra word."
+ 	byteSize := numSlots << (ShiftForWord + (ShiftForWord-2)) + BaseHeaderSize.
+ 	(BytesPerWord = 8 "David, please check this!!!!"
+ 	 and: [objFormat >= self firstLongFormat "32-bit longs and byte objects"
+ 	 and: [(numSlots bitAnd: 1) ~= 0]]) ifTrue:
+ 		["extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
+ 		 header1 := header1 bitOr: 4].
+ 	byteSize > 255 "requires size header word/full header"
+ 		ifTrue: [header3 := byteSize. hdrSize := 3. header2 := self compactClassAt: compactClassIndex]
+ 		ifFalse: [header1 := header1 bitOr: byteSize. hdrSize := 1].
+ 	^self eeAllocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3!

Item was changed:
  ----- Method: NewspeakInterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
  
  	"Initialize the NewspeakInterpreterSimulator when running the interpreter inside
  	Smalltalk. The primary responsibility of this method is to allocate
  	Smalltalk Arrays for variables that will be declared as statically-allocated
  	global arrays in the translated code."
  
  	"initialize class variables"
+ 	ObjectMemory initBytesPerWord: self wordSize.
- 	ObjectMemory initBytesPerWord: self bytesPerWord.
  	ObjectMemory initialize.
  	NewspeakInterpreter initialize.
  	super initialize.
  
  	"Note: we must initialize ConstMinusOne differently for simulation,
  		due to the fact that the simulator works only with +ve 32-bit values"
  	ConstMinusOne := self integerObjectOf: -1.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	rootTable := Array new: RootTableSize.
  	weakRoots := Array new: RootTableSize + RemapBufferSize + 100.
  	remapBuffer := Array new: RemapBufferSize.
  	gcSemaphoreIndex := 0.
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	primitiveTable := self class primitiveTable.
  	pluginList := #().
  	mappedPluginEntries := #().
  	primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
  	sendTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
  
  	"initialize NewspeakInterpreterSimulator variables used for debugging"
  	byteCount := 0.
  	sendCount := 0.
  	quitBlock := [^ self].
  	traceOn := true.
  	printSends := "printReturns := " printBytecodeAtEachStep := printContextAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	headerTypeBytes := CArrayAccessor on: HeaderTypeExtraBytes.
  	transcript := Transcript.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	!

Item was removed:
- ----- Method: ObjectMemory class>>bytesPerWord (in category 'accessing') -----
- bytesPerWord
- 	"Answer the width of an object pointer, in bytes."
- 
- 	^BytesPerWord!

Item was added:
+ ----- Method: ObjectMemory class>>wordSize (in category 'accessing') -----
+ wordSize
+ 	"Answer the width of an object pointer, in bytes."
+ 
+ 	^BytesPerWord!

Item was added:
+ ----- Method: ObjectMemory>>byteFormatForNumBytes: (in category 'header access') -----
+ byteFormatForNumBytes: numBytes
+ 	^self firstByteFormat + (numBytes bitAnd: 3)!

Item was removed:
- ----- Method: ObjectMemory>>bytesPerWord (in category 'initialization') -----
- bytesPerWord
- 	"Answer the size of an object pointer in bytes."
- 
- 	^BytesPerWord!

Item was added:
+ ----- Method: ObjectMemory>>longFormatForNumBytes: (in category 'header access') -----
+ longFormatForNumBytes: numBytes
+ 	"In ObjectMemory the odd bits for 32-bit indexable objects, needed in the 64-bit VM, is
+ 	 not stored in the format field."
+ 	^self firstLongFormat!

Item was added:
+ ----- Method: ObjectMemory>>wordSize (in category 'initialization') -----
+ wordSize
+ 	"Answer the size of an object pointer in bytes."
+ 
+ 	^4!

Item was removed:
- ----- Method: Spur32BitMemoryManager class>>bytesPerWord (in category 'word size') -----
- bytesPerWord
- 	^4!

Item was added:
+ ----- Method: Spur32BitMemoryManager class>>wordSize (in category 'word size') -----
+ wordSize
+ 	^4!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>longFormatForNumBytes: (in category 'header format') -----
+ longFormatForNumBytes: numBytes
+ 	^self firstLongFormat!

Item was removed:
- ----- Method: Spur64BitMemoryManager class>>bytesPerWord (in category 'word size') -----
- bytesPerWord
- 	^8!

Item was added:
+ ----- Method: Spur64BitMemoryManager class>>wordSize (in category 'word size') -----
+ wordSize
+ 	^8!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>longFormatForNumBytes: (in category 'header format') -----
+ longFormatForNumBytes: numBytes
+ 	"Answer firstLongFormat with the odd bit set if numBytes is an odd number of 4-byte units."
+ 	^self firstLongFormat + (numBytes >> 2 bitAnd: 1)!

Item was removed:
- ----- Method: SpurMemoryManager class>>bytesPerWord (in category 'word size') -----
- bytesPerWord
- 	^self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager class>>initializeWithOptions: (in category 'class initialization') -----
  initializeWithOptions: optionsDictionary
  	"SpurMemoryManager initializeWithOptions: Dictionary new"
  
  	self initBytesPerWord: (self == SpurMemoryManager
  								ifTrue: [optionsDictionary at: #BytesPerWord ifAbsent: [4]]
+ 								ifFalse: [self wordSize]).
- 								ifFalse: [self bytesPerWord]).
  	BytesPerOop := optionsDictionary at: #BytesPerOop ifAbsent: [BytesPerWord].
  
  	self initializeSpecialObjectIndices.
  	self initializeCompactClassIndices.
  	self initializePrimitiveErrorCodes.
  	self initializeObjectHeaderConstants!

Item was added:
+ ----- Method: SpurMemoryManager class>>wordSize (in category 'word size') -----
+ wordSize
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>byteFormatForNumBytes: (in category 'header format') -----
+ byteFormatForNumBytes: numBytes
+ 	^self firstByteFormat + (numBytes bitAnd: self wordSize - 1)!

Item was added:
+ ----- Method: SpurMemoryManager>>longFormatForNumBytes: (in category 'header format') -----
+ longFormatForNumBytes: numBytes
+ 	^self subclassResponsibility!

Item was changed:
  ----- Method: StackInterpreter>>argumentCountOfClosure: (in category 'internal interpreter access') -----
  argumentCountOfClosure: closurePointer
  	<api> "for Cogit"
+ 	<inline: true>
  	^self quickFetchInteger: ClosureNumArgsIndex ofObject: closurePointer!

Item was changed:
  ----- Method: StackInterpreter>>closureIn:numArgs:instructionPointer:copiedValues: (in category 'control primitives') -----
  closureIn: context numArgs: numArgs instructionPointer: initialIP copiedValues: copiedValues
  	| newClosure numCopied |
  	<inline: true>
  	"numCopied should be zero for nil"
  	numCopied := objectMemory fetchWordLengthOf: copiedValues.
+ 	ClassBlockClosureCompactIndex ~= 0
+ 		ifTrue:
+ 			[newClosure := objectMemory
+ 								eeInstantiateClassIndex: ClassBlockClosureCompactIndex
+ 								format: objectMemory indexablePointersFormat
+ 								numSlots: ClosureFirstCopiedValueIndex + numCopied]
+ 		ifFalse:
+ 			[newClosure := objectMemory
+ 								eeInstantiateSmallClass: (objectMemory splObj: ClassBlockClosure)
+ 								sizeInBytes: (BytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + BaseHeaderSize].
- 	newClosure := objectMemory
- 					eeInstantiateSmallClass: (objectMemory splObj: ClassBlockClosure)
- 					sizeInBytes: (BytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + BaseHeaderSize.
  	"Assume: have just allocated a new closure; it must be young. Thus, can use unchecked stores."
+ 	objectMemory
+ 		storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: context;
+ 		storePointerUnchecked: ClosureStartPCIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: initialIP);
+ 		storePointerUnchecked: ClosureNumArgsIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: numArgs).
- 	objectMemory storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: context.
- 	objectMemory storePointerUnchecked: ClosureStartPCIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: initialIP).
- 	objectMemory storePointerUnchecked: ClosureNumArgsIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: numArgs).
  	0 to: numCopied - 1 do:
  		[:i|
  		objectMemory storePointerUnchecked: i + ClosureFirstCopiedValueIndex
  			ofObject: newClosure
  			withValue: (objectMemory fetchPointer: i ofObject: copiedValues)].
  	^newClosure!

Item was changed:
  ----- Method: StackInterpreter>>closureIn:numArgs:instructionPointer:numCopiedValues: (in category 'control primitives') -----
  closureIn: context numArgs: numArgs instructionPointer: initialIP numCopiedValues: numCopied
  	| newClosure |
  	<inline: true>
+ 	ClassBlockClosureCompactIndex ~= 0
+ 		ifTrue:
+ 			[newClosure := objectMemory
+ 								eeInstantiateClassIndex: ClassBlockClosureCompactIndex
+ 								format: objectMemory indexablePointersFormat
+ 								numSlots: ClosureFirstCopiedValueIndex + numCopied]
+ 		ifFalse:
+ 			[self assert: (BytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + BaseHeaderSize <= 252.
+ 			 newClosure := objectMemory
+ 								eeInstantiateSmallClass: (objectMemory splObj: ClassBlockClosure)
+ 								sizeInBytes: (BytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + BaseHeaderSize].
- 	self assert: (BytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + BaseHeaderSize <= 252.
- 	newClosure := objectMemory
- 					eeInstantiateSmallClass: (objectMemory splObj: ClassBlockClosure)
- 					sizeInBytes: (BytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + BaseHeaderSize.
  	"Assume: have just allocated a new closure; it must be young. Thus, can use unchecked stores."
  	objectMemory storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: context.
  	objectMemory storePointerUnchecked: ClosureStartPCIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: initialIP).
  	objectMemory storePointerUnchecked: ClosureNumArgsIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: numArgs).
  	^newClosure!

Item was changed:
  ----- Method: StackInterpreter>>floatObjectOf: (in category 'object format') -----
  floatObjectOf: aFloat
  	| newFloatObj |
  	<inline: false>
  	<var: #aFloat type: #double>
+ 	newFloatObj := objectMemory
+ 						eeInstantiateClassIndex: ClassFloatCompactIndex
+ 						format: objectMemory firstLongFormat
+ 						numSlots: 8 / objectMemory wordSize.
+ 	objectMemory storeFloatAt: newFloatObj + objectMemory baseHeaderSize from: aFloat.
+ 	^newFloatObj!
- 	self flag: #Dan.
- 	newFloatObj := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassFloat) sizeInBytes: 8+BaseHeaderSize.
- 	objectMemory storeFloatAt: newFloatObj + BaseHeaderSize from: aFloat.
- 	^ newFloatObj.
- !

Item was changed:
  ----- Method: StackInterpreter>>positive32BitIntegerFor: (in category 'primitive support') -----
  positive32BitIntegerFor: integerValue
- 
  	| newLargeInteger |
+ 	"Note - integerValue is interpreted as POSITIVE, eg, as the result of Bitmap>at:, or integer>bitAnd:."
+ 	(integerValue >= 0
+ 	 and: [objectMemory isIntegerValue: integerValue]) ifTrue:
+ 		[^objectMemory integerObjectOf: integerValue].
- 	"Note - integerValue is interpreted as POSITIVE, eg, as the result of
- 		Bitmap>at:, or integer>bitAnd:."
- 	integerValue >= 0
- 		ifTrue: [(objectMemory isIntegerValue: integerValue)
- 					ifTrue: [^ objectMemory integerObjectOf: integerValue]].
  
+ 	newLargeInteger := objectMemory
+ 							eeInstantiateClassIndex: ClassLargePositiveIntegerCompactIndex
+ 							format: (objectMemory byteFormatForNumBytes: 4)
+ 							numSlots: 1.
+ 	objectMemory
+ 		storeByte: 3 ofObject: newLargeInteger withValue: (integerValue >> 24 bitAnd: 16rFF);
+ 		storeByte: 2 ofObject: newLargeInteger withValue: (integerValue >> 16 bitAnd: 16rFF);
+ 		storeByte: 1 ofObject: newLargeInteger withValue: (integerValue >>   8 bitAnd: 16rFF);
+ 		storeByte: 0 ofObject: newLargeInteger withValue: (integerValue ">> 0" bitAnd: 16rFF).
- 	self cppIf: BytesPerWord = 4
- 		ifTrue: "Faster instantiateSmallClass: currently only works with integral word size."
- 			[newLargeInteger := objectMemory
- 									eeInstantiateSmallClass: (objectMemory splObj: ClassLargePositiveInteger)
- 									sizeInBytes: BaseHeaderSize + 4]
- 		ifFalse: "Cant use instantiateSmallClass: due to integral word requirement."
- 			[newLargeInteger := objectMemory
- 									eeInstantiateClass: (objectMemory splObj: ClassLargePositiveInteger)
- 									indexableSize: 4].
- 	objectMemory storeByte: 3 ofObject: newLargeInteger withValue: ((integerValue >> 24) bitAnd: 16rFF).
- 	objectMemory storeByte: 2 ofObject: newLargeInteger withValue: ((integerValue >> 16) bitAnd: 16rFF).
- 	objectMemory storeByte: 1 ofObject: newLargeInteger withValue: ((integerValue >> 8) bitAnd: 16rFF).
- 	objectMemory storeByte: 0 ofObject: newLargeInteger withValue: (integerValue bitAnd: 16rFF).
  	^newLargeInteger!

Item was removed:
- ----- Method: VMMaker>>bytesPerWord (in category 'initialize') -----
- bytesPerWord
- 	"Return the bytes in a word for the chosen 32bit/64bit pointer setup chosen"
- 	^is64BitVM ifTrue:[8] ifFalse:[4]!

Item was changed:
  ----- Method: VMMaker>>configurationInfo (in category 'objects from disk') -----
  configurationInfo
  	"build a simple Array of the configuration information that would be 
  	 usefully saved for later reloading:- 
  		the list of internal & external plugins,
  		the flags,
  		the platform name,
  		the two major directory names,
  		bytePerWord
  		two flags indicating whether each directory is relative to the current directory or not.
  		the interpreter class name"
  	| isRelative makeRelative |
  	isRelative := [:pn| pn beginsWith: FileDirectory default pathName].
  	makeRelative := [:pn|
  					(isRelative value: pn)
  						ifTrue: [pn allButFirst: FileDirectory default pathName size + 1]
  						ifFalse: [pn]].
  	^{ internalPlugins asArray.
  		externalPlugins asArray.
  		inline.
  		forBrowser.
  		platformName.
  		makeRelative value: self sourceDirectory pathName.
  		makeRelative value: self platformRootDirectory pathName.
+ 		self wordSize.
- 		self bytesPerWord.
  		isRelative value: self sourceDirectory pathName.
  		isRelative value: self platformRootDirectory pathName.
  		self interpreterClassName
  	  }!

Item was changed:
  ----- Method: VMMaker>>generateInterpreterFile (in category 'generate sources') -----
  generateInterpreterFile
  	"Translate the Smalltalk description of the virtual machine into C.  If 'self doInlining' is true, small method bodies are inlined to reduce procedure call overhead.  On the PPC, this results in a factor of three speedup with only 30% increase in code size.  Subclasses can use specialised versions of CCodeGenerator and interpreterClass."
  
  	| cg vmHeaderContents |
  	cg := [self buildCodeGeneratorForInterpreter]
  			on: Notification
  			do: [:ex|
  				ex tag == #getVMMaker
  					ifTrue: [ex resume: self]
  					ifFalse: [(ex respondsTo: #rearmHandlerDuring:)
  								ifTrue: [ex rearmHandlerDuring: [ex pass]]
  								ifFalse: [ex pass]]].
  	self needsToRegenerateInterpreterFile ifFalse: [^nil].
  	cg removeUnneededBuiltins.
  	self interpreterClass preGenerationHook: cg.
  
+ 	vmHeaderContents := cg vmHeaderContentsWithBytesPerWord: self wordSize.
- 	vmHeaderContents := cg vmHeaderContentsWithBytesPerWord: self bytesPerWord.
  	(cg needToGenerateHeader: self interpreterHeaderName file: self interpreterHeaderPath contents: vmHeaderContents) ifTrue:
  		[cg storeHeaderOnFile: self interpreterHeaderPath contents: vmHeaderContents].
  	cg storeCodeOnFile: (self sourceFilePathFor: self interpreterClass sourceFileName) doInlining: self doInlining.
  	self interpreterClass additionalHeadersDo:
  		[:headerName :headerContents| | filePath |
  		 filePath := self coreVMDirectory fullNameFor: headerName.
  		 (cg needToGenerateHeader: headerName file: filePath contents: headerContents) ifTrue:
  			 [cg storeHeaderOnFile: filePath contents: headerContents]].
  	self interpreterClass apiExportHeaderName ifNotNil:
  		[cg storeAPIExportHeader: self interpreterClass apiExportHeaderName
  			OnFile: (self sourceFilePathFor: self interpreterClass apiExportHeaderName)].
  	self gnuifyInterpreterFile!

Item was added:
+ ----- Method: VMMaker>>wordSize (in category 'initialize') -----
+ wordSize
+ 	"Return the bytes in a word for the chosen 32bit/64bit pointer setup chosen"
+ 	^is64BitVM ifTrue:[8] ifFalse:[4]!



More information about the Vm-dev mailing list