[Vm-dev] VM Maker: VMMaker-dtl.177.mcz

squeak-dev-noreply at lists.squeakfoundation.org squeak-dev-noreply at lists.squeakfoundation.org
Fri May 28 04:03:59 UTC 2010


Dave Lewis uploaded a new version of VMMaker to project VM Maker:
http://www.squeaksource.com/VMMaker/VMMaker-dtl.177.mcz

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

Name: VMMaker-dtl.177
Author: dtl
Time: 27 May 2010, 9:59:27 am
UUID: 27692d97-0397-4abd-a917-b37879bec3c1
Ancestors: VMMaker-dtl.176

VMMaker 4.2.3

Remove the "64-bit image" checkbox from VMMakerTool user interface.

Change default source directory for generated sources to src (not src32 or src64).

Remove 32/64 bit word size methods and variables from VMMaker and VMMakerTool.

Building a VM for a 64-bit image is now controlled by the compile time macro SQ_VI_BYTES_PER_WORD. If not defined, the macro is set to 4 to support a standard 32-bit image.

=============== Diff against VMMaker-dtl.176 ===============

Item was changed:
  ----- Method: VMMaker>>sourceDirectory (in category 'target directories') -----
  sourceDirectory
  	| fd |
+ 	fd := FileDirectory default
+ 				directoryNamed: (sourceDirName
+ 						ifNil: [self class sourceDirName]).
- 	fd := FileDirectory default directoryNamed: (sourceDirName
- 		ifNil: [self class sourceDirName, self vmBitnessString]).
  	fd assureExistence.
  	^ fd!

Item was changed:
+ ----- Method: VMMakerTool>>toggle64BitVM (in category 'deprecated') -----
- ----- Method: VMMakerTool>>toggle64BitVM (in category 'settings') -----
  toggle64BitVM
+ 	"This selector may be used by obsolete instances of VMMakerTool. The
+ 	64-bit setting of VMMaker is no longer functionally relevant, but this method
+ 	is retained to prevent problems with existing VMMakerTool instances that
+ 	may exist in some images."!
- 	self set64BitVM: self isFor64BitVM not!

Item was changed:
  ----- Method: VMMakerTool>>addSecondButtonRowToWindow:startingAt: (in category 'window construction') -----
  addSecondButtonRowToWindow: sysWin startingAt: initialVerticalOffset 
  	| verticalOffset box |
  	verticalOffset := initialVerticalOffset.
  	"add a row of buttons to start up various actions"
  	box := AlignmentMorph new vResizing: #shrinkWrap;  layoutInset: 6 at 3; cellInset: 6 at 0; wrapCentering: #center.
  	box addMorph: (TextMorph new contents: 'Generate:' translated asText allBold) lock.
  	box addMorphBack: (SimpleButtonMorph new target: self;
  			 label: 'Entire';
  			 actionSelector: #generateAll;
  			 hResizing: #spaceFill;
  			 setBalloonText: 'Generate the sources for the core VM and all chosen internal and external plugins').
  	box addMorphBack: (SimpleButtonMorph new target: self;
  			 label: 'Core+Internal';
  			 actionSelector: #generateCore;
  			 hResizing: #spaceFill;
  			 setBalloonText: 'Generate the sources for the core vm and any internal plugins').
  
  	box addMorphBack: (SimpleButtonMorph new target: self;
  			 label: 'External Plugins';
  			 actionSelector: #generateExternal;
  			 hResizing: #spaceFill;
  			 setBalloonText: 'Generate the sources for all external plugins').
- 	box addMorphBack: ((AlignmentMorph inARow: {StringMorph new contents: '64-bit image'. UpdatingThreePhaseButtonMorph checkBox target: self;
- 				 actionSelector: #toggle64BitVM;
- 				 getSelector: #isFor64BitVM}) layoutInset: 3;
- 			 cellInset: 5;
- 			 color: Color blue veryMuchLighter;
- 			 setBalloonText: 'Build (32- or 64-bit) VM to run 64-bit images. Default is false to support normal 32-bit images.' yourself).
  	sysWin
  		addMorph: box
  		fullFrame: (LayoutFrame
  				fractions: (0 @ 0 corner: 1 @ 0)
  				offsets: (0 @ verticalOffset corner: 0 @ (verticalOffset := verticalOffset + box height - 1))).
  
  	^verticalOffset.!

Item was added:
+ ----- Method: CCodeGenerator>>emitDefineBytesPerWordOn: (in category 'C code generator') -----
+ emitDefineBytesPerWordOn: aStream
+ 	"Define word size dependent constants. These are mirrored by class
+ 	variables in ObjectMemory. The macro definitions here are used at compile
+ 	time to permit building a VM for either 32-bit or 64-bit object memory from
+ 	a single generated code base.
+ 	
+ 	If SQ_VI_BYTES_PER_WORD is defined as 8 (e.g. in config.h), then a VM for
+ 	64-bit image will be built. Otherwise, a VM for 32-bit image is built."
+ 
+ 	aStream cr;
+ 		nextPutAll: '/*'; cr;
+ 		nextPutAll: ' * define SQ_VI_BYTES_PER_WORD 8 for a 64-bit word size VM'; cr;
+ 		nextPutAll: ' * and default to SQ_VI_BYTES_PER_WORD 4 for a 32-bit word size VM'; cr;
+ 		nextPutAll: ' */'; cr;
+ 		nextPutAll: '#ifndef SQ_VI_BYTES_PER_WORD'; cr;
+ 		nextPutAll: '# define SQ_VI_BYTES_PER_WORD ';
+ 		print: 4; cr; "default to word size 4"
+ 		nextPutAll: '#endif'; cr; cr;
+ 		nextPutAll: '#define BYTES_PER_WORD SQ_VI_BYTES_PER_WORD'; cr;
+ 		nextPutAll: '#define BASE_HEADER_SIZE SQ_VI_BYTES_PER_WORD'; cr;
+ 
+ 		"Define various constants that depend on BytesPerWord"
+ 		nextPutAll: '#if (BYTES_PER_WORD == 4) // 32-bit object memory'; cr;
+ 		nextPutAll: '# define WORD_MASK 0xffffffff'; cr; "(1 bitShift: BytesPerWord*8) - 1"
+ 		nextPutAll: '# define SHIFT_FOR_WORD 2'; cr; "(BytesPerWord log: 2) rounded"
+ 		nextPutAll: '# define SMALL_CONTEXT_SIZE 92'; cr; "ContextFixedSizePlusHeader + 16 * BytesPerWord"
+ 		"Large contexts have 56 indexable fileds.  Max with single header word."
+ 		"However note that in 64 bits, for now, large contexts have 3-word headers"
+ 		nextPutAll: '# define LARGE_CONTEXT_SIZE 252'; cr; "ContextFixedSizePlusHeader + 56 * BytesPerWord."
+ 		nextPutAll: '# define SIZE_MASK 0xfc'; cr; "Base header word bit field"
+ 		nextPutAll: '# define LONG_SIZE_MASK 0xfffffffc'; cr; "Base header word bit field"
+ 		nextPutAll: '# define SIZE_4_BIT 0'; cr;
+ 		nextPutAll: '# define MARK_BIT 0x80000000'; cr; "Top bit, 1 bitShift: BytesPerWord*8 - 1"
+ 		nextPutAll: '# define ROOT_BIT 0x40000000'; cr; "Next-to-top bit, 1 bitShift: BytesPerWord*8 - 2"
+ 		nextPutAll: '# define ALL_BUT_MARK_BIT 0x7fffffff'; cr; "WordMask - MarkBit."
+ 		nextPutAll: '# define ALL_BUT_ROOT_BIT 0xbfffffff'; cr; "WordMask - RootBit"
+ 		nextPutAll: '# define ALL_BUT_TYPE_MASK 0xfffffffc'; cr; "WordMask - TypeMask"
+ 		nextPutAll: '# define ALL_BUT_MARK_BIT_AND_TYPE_MASK 0x7ffffffc'; cr; "AllButTypeMask - MarkBit"
+ 		nextPutAll: '# define ALL_BUT_HASH_BITS 0xe001ffff'; cr;
+ 
+ 		nextPutAll: '#else // 64-bit object memory'; cr;
+ 		nextPutAll: '# define WORD_MASK 0xffffffffffffffff'; cr;
+ 		nextPutAll: '# define SHIFT_FOR_WORD 3'; cr;
+ 		nextPutAll: '# define SMALL_CONTEXT_SIZE 184'; cr;
+ 		nextPutAll: '# define LARGE_CONTEXT_SIZE 504'; cr;
+ 		nextPutAll: '# define SIZE_MASK 0xf8'; cr; "Lose the 4 bit in temp 64-bit chunk format"
+ 		nextPutAll: '# define LONG_SIZE_MASK 0xfffffffffffffff8'; cr;
+ 		"The 4 bit is excluded from SIZE_MASK for 64-bit object memory, but need it"
+ 		"for ST size, so define SIZE_4_BIT."
+ 		nextPutAll: '# define SIZE_4_BIT 4'; cr;
+ 		nextPutAll: '# define MARK_BIT 0x8000000000000000'; cr;
+ 		nextPutAll: '# define ROOT_BIT 0x4000000000000000'; cr;
+ 		nextPutAll: '# define ALL_BUT_MARK_BIT 0x7fffffffffffffff'; cr;
+ 		nextPutAll: '# define ALL_BUT_ROOT_BIT 0xbfffffffffffffff'; cr;
+ 		nextPutAll: '# define ALL_BUT_TYPE_MASK 0xfffffffffffffffc'; cr;
+ 		nextPutAll: '# define ALL_BUT_MARK_BIT_AND_TYPE_MASK 0x7ffffffffffffffc'; cr;
+ 		nextPutAll: '# define ALL_BUT_HASH_BITS 0xffffffffe001ffff'; cr;
+ 		nextPutAll: '#endif //  (BYTES_PER_WORD == 4)'; cr
+ 	
+ !

Item was added:
+ ----- Method: ObjectMemory class>>initializeObjectWordConstants (in category 'initialization') -----
+ initializeObjectWordConstants
+ 
+ 	Byte0Shift := 0.
+ 	Byte1Shift := 8.
+ 	Byte2Shift := 16.
+ 	Byte3Shift := 24.
+ 	Byte4Shift := 32.
+ 	Byte5Shift := 40.
+ 	Byte6Shift := 48.
+ 	Byte7Shift := 56.
+ 
+ 	Byte0Mask := 16r00000000000000FF.
+ 	Byte1Mask := 16r000000000000FF00.
+ 	Byte2Mask := 16r0000000000FF0000.
+ 	Byte3Mask := 16r00000000FF000000.
+ 	Byte4Mask := 16r000000FF00000000.
+ 	Byte5Mask := 16r0000FF0000000000.
+ 	Byte6Mask := 16r00FF000000000000.
+ 	Byte7Mask := 16rFF00000000000000.
+ 	Bytes3to0Mask := 16r00000000FFFFFFFF.
+ 	Bytes7to4Mask := 16rFFFFFFFF00000000.
+ 							
+ 	Byte1ShiftNegated := Byte1Shift negated.
+ 	Byte3ShiftNegated := Byte3Shift negated.
+ 	Byte4ShiftNegated := Byte4Shift negated.
+ 	Byte5ShiftNegated := Byte5Shift negated.
+ 	Byte7ShiftNegated := Byte7Shift negated!

Item was changed:
  ----- Method: InterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
  
  	"Initialize the InterpreterSimulator 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 initializeConstants.
- 	ObjectMemory initializeWithBytesToWord: self bytesPerWord.
  	Interpreter 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.
  	semaphoresUseBufferA := true.
  	semaphoresToSignalA := Array new: SemaphoresToSignalSize.
  	semaphoresToSignalB := Array new: SemaphoresToSignalSize.
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	primitiveTable := self class primitiveTable.
  	obsoleteNamedPrimitiveTable := 
  		CArrayAccessor on: (self class obsoleteNamedPrimitiveTable copyWith: (Array new: 3)).
  	obsoleteIndexedPrimitiveTable := CArrayAccessor on: 
  		(self class obsoleteIndexedPrimitiveTable collect:[:spec| 
  			CArrayAccessor on:
  				(spec ifNil:[Array new: 3] 
  					  ifNotNil:[Array with: spec first with: spec second with: nil])]).
  	pluginList := #().
  	mappedPluginEntries := #().
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := 0.
  	sendCount := 0.
  	quitBlock := [^ self].
  	traceOn := true.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	filesOpen := OrderedCollection new.
  	headerTypeBytes := CArrayAccessor on: (Array with: self bytesPerWord * 2 with: self bytesPerWord with: 0 with: 0).
  	transcript := Transcript.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	!

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 |
  	self needsToRegenerateInterpreterFile ifFalse: [^nil].
  	self interpreterClass initialize.
+ 	ObjectMemory initializeConstants.
- 	ObjectMemory initializeWithBytesToWord: self bytesPerWord.
  	cg := self createCodeGenerator
  		addClass: self interpreterClass;
  		addClass: ObjectMemory.
  	(Smalltalk classNamed: #MemoryAccess) ifNotNilDo: [:ma |
  		ma isEnabled ifTrue: [cg addClass: ma]].
+ 	cg storeHeaderOnFile: self interpreterHeaderPath.
- 	cg storeHeaderOnFile: self interpreterHeaderPath bytesPerWord: self bytesPerWord.
  	cg storeCodeOnFile: self interpreterFilePath doInlining: self doInlining!

Item was added:
+ ----- Method: ObjectMemory class>>initializeConstants (in category 'initialization') -----
+ initializeConstants
+ 	"ObjectMemory initializeConstants"
+ 
+ 	self initializeObjectWordConstants.
+ 
+ 	"Translation flags (booleans that control code generation via conditional translation):"
+ 	DoAssertionChecks := false.  "generate assertion checks"
+ 	DoBalanceChecks := false. "generate stack balance checks"
+ 
+ 	self initializeSpecialObjectIndices.
+ 	self initializeObjectHeaderConstants.
+ 
+ 	CtxtTempFrameStart := 6.  "Copy of TempFrameStart in Interp"
+ 	ContextFixedSizePlusHeader := CtxtTempFrameStart + 1.
+ 	
+ 	LargeContextBit := 16r40000.  "This bit set in method headers if large context is needed."
+ 	NilContext := 1.  "the oop for the integer 0; used to mark the end of context lists"
+ 
+ 	RemapBufferSize := 25.
+ 	RootTableSize := 2500.  	"number of root table entries (4 bytes/entry)"
+ 	RootTableRedZone := RootTableSize - 100.	"red zone of root table - when reached we force IGC"
+ 
+ 	"tracer actions"
+ 	StartField := 1.
+ 	StartObj := 2.
+ 	Upward := 3.
+ 	Done := 4.
+ 
+ 	ExtraRootSize := 2048. "max. # of external roots"!

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, and the two major directory names"
  	^ Array new writeStream nextPut: internalPlugins;
  		 nextPut: externalPlugins;
  		 nextPut: inline;
  		 nextPut: forBrowser;
  		 nextPut: self platformName;
  		 nextPut: self sourceDirectory pathName;
  		 nextPut: self platformRootDirectory pathName;
- 		nextPut: self bytesPerWord;
  	contents!

Item was added:
+ ----- Method: CCodeGenerator>>storeHeaderOnFile: (in category 'public') -----
+ storeHeaderOnFile: fileName
+ 	"Store C header code for this interpreter on the given file."
+ 
+ 	| aStream |
+ 	aStream := CrLfFileStream forceNewFileNamed: fileName.
+ 	aStream ifNil: [Error signal: 'Could not open C header file: ', fileName].
+ 	aStream
+ 		nextPutAll: '/* ';
+ 		nextPutAll: VMMaker headerNotice;
+ 		nextPutAll: ' */'; cr; cr.
+ 	self emitVmmVersionOn: aStream.
+ 	self emitDefineBytesPerWordOn: aStream.
+ 	self emitDefineMemoryAccessInImageOn: aStream.
+ 	aStream cr.
+ 	aStream close
+ !

Item was changed:
(excessive method size, no diff calculated)

Item was changed:
+ ----- Method: VMMakerTool>>isFor64BitVM (in category 'deprecated') -----
- ----- Method: VMMakerTool>>isFor64BitVM (in category 'generate sources') -----
  isFor64BitVM
+ 	"This selector may be used by obsolete instances of VMMakerTool. The
+ 	64-bit setting of VMMaker is no longer functionally relevant, but this method
+ 	is retained to prevent problems with existing VMMakerTool instances that
+ 	may exist in some images."!
- "do I build a 64bit VM or not?"
- 	^vmMaker isFor64BitVM!

Item was changed:
  ----- Method: VMMaker>>loadConfiguration: (in category 'objects from disk') -----
  loadConfiguration: aConfigArray
  	"load the configuration but ignore the platformName - the platform name must have been handled during the creation of this vmmaker in order for it to work correctly"
  
  	inline := aConfigArray at:3.
  	forBrowser := aConfigArray at: 4.
  	"This part must be ignored --> self setPlatName: (aConfigArray at: 5)."
  	self sourceDirectoryName: (aConfigArray at: 6).
  	self platformRootDirectoryName: ( aConfigArray at:7).
  	self initializeAllPlugins.
  	self internal: (aConfigArray at:1) external:(aConfigArray at:2).
  	aConfigArray size >7 ifTrue:["new enough to have 64bitness flag"
+ 		"But this flag is now ignored because code generation is the same for 32 and 64 bit images now"
+ 		"Note - reserve slot 7 for backward compatibility. Any new slots added should begin at 8"].
- 		(aConfigArray at:8) =8 ifTrue:[self for64BitVM].
- 		(aConfigArray at:8) =4 ifTrue:[self for32BitVM]].
  	self changed: #reinitialize !

Item was changed:
  ----- Method: VMMaker>>initialize (in category 'initialize') -----
  initialize
  	logger := Transcript.
  	inline := true.
  	forBrowser := false.
  	internalPlugins := SortedCollection new.
  	externalPlugins := SortedCollection new.
  	platformName := self class machinesDirName.
- 	is64BitVM := Smalltalk wordSize == 8.
  	allFilesList := Dictionary new.
  	interpreterClassName := Interpreter name!

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
  
  	"VMMaker versionString"
  
+ 	^'4.2.3'!
- 	^'4.2.2'!

Item was removed:
- ----- Method: ObjectMemory class>>initializeWithBytesToWord: (in category 'initialization') -----
- initializeWithBytesToWord:  numberOfBytesInAWord
- 	"ObjectMemory initializeWithBytesToWord: Smalltalk wordSize"
- 
- 	self initBytesPerWord: numberOfBytesInAWord.
- 
- 	"Translation flags (booleans that control code generation via conditional translation):"
- 	DoAssertionChecks := false.  "generate assertion checks"
- 	DoBalanceChecks := false. "generate stack balance checks"
- 
- 	self initializeSpecialObjectIndices.
- 	self initializeObjectHeaderConstants.
- 
- 	CtxtTempFrameStart := 6.  "Copy of TempFrameStart in Interp"
- 	ContextFixedSizePlusHeader := CtxtTempFrameStart + 1.
- 	
- 	LargeContextBit := 16r40000.  "This bit set in method headers if large context is needed."
- 	NilContext := 1.  "the oop for the integer 0; used to mark the end of context lists"
- 
- 	RemapBufferSize := 25.
- 	RootTableSize := 2500.  	"number of root table entries (4 bytes/entry)"
- 	RootTableRedZone := RootTableSize - 100.	"red zone of root table - when reached we force IGC"
- 
- 	"tracer actions"
- 	StartField := 1.
- 	StartObj := 2.
- 	Upward := 3.
- 	Done := 4.
- 
- 	ExtraRootSize := 2048. "max. # of external roots"!

Item was removed:
- ----- Method: ObjectMemory class>>initBytesPerWord: (in category 'initialization') -----
- initBytesPerWord: unused
- 
- 	Byte0Shift := 0.
- 	Byte1Shift := 8.
- 	Byte2Shift := 16.
- 	Byte3Shift := 24.
- 	Byte4Shift := 32.
- 	Byte5Shift := 40.
- 	Byte6Shift := 48.
- 	Byte7Shift := 56.
- 
- 	Byte0Mask := 16r00000000000000FF.
- 	Byte1Mask := 16r000000000000FF00.
- 	Byte2Mask := 16r0000000000FF0000.
- 	Byte3Mask := 16r00000000FF000000.
- 	Byte4Mask := 16r000000FF00000000.
- 	Byte5Mask := 16r0000FF0000000000.
- 	Byte6Mask := 16r00FF000000000000.
- 	Byte7Mask := 16rFF00000000000000.
- 	Bytes3to0Mask := 16r00000000FFFFFFFF.
- 	Bytes7to4Mask := 16rFFFFFFFF00000000.
- 							
- 	Byte1ShiftNegated := Byte1Shift negated.
- 	Byte3ShiftNegated := Byte3Shift negated.
- 	Byte4ShiftNegated := Byte4Shift negated.
- 	Byte5ShiftNegated := Byte5Shift negated.
- 	Byte7ShiftNegated := Byte7Shift negated!

Item was removed:
- ----- Method: CCodeGenerator>>storeHeaderOnFile:bytesPerWord: (in category 'public') -----
- storeHeaderOnFile: fileName bytesPerWord: bytesPerWord
- 	"Store C header code for this interpreter on the given file."
- 
- 	| aStream |
- 	aStream := CrLfFileStream forceNewFileNamed: fileName.
- 	aStream ifNil: [Error signal: 'Could not open C header file: ', fileName].
- 	aStream
- 		nextPutAll: '/* ';
- 		nextPutAll: VMMaker headerNotice;
- 		nextPutAll: ' */'; cr; cr.
- 	self emitVmmVersionOn: aStream.
- 	self emitDefineBytesPerWord: bytesPerWord on: aStream.
- 	self emitDefineMemoryAccessInImageOn: aStream.
- 	aStream cr.
- 	aStream close
- !

Item was removed:
- ----- Method: VMMaker>>for32BitVM (in category 'initialize') -----
- for32BitVM
- "set my flag to make a 32bit pointer model VM"
- 	is64BitVM := false.
- 	self changed: #sourcePathText.!

Item was removed:
- ----- Method: VMMaker>>vmBitnessString (in category 'target directories') -----
- vmBitnessString
- 	"Return a string of 32 or 64 depending on the is64BitVM valuse"
- 	^is64BitVM ifTrue:['64'] ifFalse:['32']!

Item was removed:
- ----- Method: VMMakerTool>>set64BitVM: (in category 'generate sources') -----
- set64BitVM: boolean
- "do I build a 64bit VM or not?"
- 	boolean ifTrue:[vmMaker for64BitVM] ifFalse:[vmMaker for32BitVM].
- 	self changed: #sourcePathText!

Item was removed:
- ----- Method: VMMaker>>isFor64BitVM (in category 'initialize') -----
- isFor64BitVM
- "is my flag to make a 64bit pointer model VM?"
- 	^is64BitVM!

Item was removed:
- ----- Method: CCodeGenerator>>emitDefineBytesPerWord:on: (in category 'C code generator') -----
- emitDefineBytesPerWord: bytesPerWord on: aStream
- 	"Define word size dependent constants. These are mirrored by class
- 	variables in ObjectMemory. The macro definitions here are used at compile
- 	time to permit building a VM for either 32-bit or 64-bit object memory from
- 	a single generated code base.
- 	
- 	If SQ_VI_BYTES_PER_WORD is defined as 8 (e.g. in config.h), then a VM for
- 	64-bit image will be built. Otherwise, a VM for 32-bit image is built."
- 
- 	aStream cr;
- 		nextPutAll: '/*'; cr;
- 		nextPutAll: ' * define SQ_VI_BYTES_PER_WORD 8 for a 64-bit word size VM'; cr;
- 		nextPutAll: ' * and default to SQ_VI_BYTES_PER_WORD 4 for a 32-bit word size VM'; cr;
- 		nextPutAll: ' */'; cr;
- 		nextPutAll: '#ifndef SQ_VI_BYTES_PER_WORD'; cr;
- 		nextPutAll: '# define SQ_VI_BYTES_PER_WORD ';
- 		print: bytesPerWord; cr;
- 		nextPutAll: '#endif'; cr; cr;
- 		nextPutAll: '#define BYTES_PER_WORD SQ_VI_BYTES_PER_WORD'; cr;
- 		nextPutAll: '#define BASE_HEADER_SIZE SQ_VI_BYTES_PER_WORD'; cr;
- 
- 		"Define various constants that depend on BytesPerWord"
- 		nextPutAll: '#if (BYTES_PER_WORD == 4) // 32-bit object memory'; cr;
- 		nextPutAll: '# define WORD_MASK 0xffffffff'; cr; "(1 bitShift: BytesPerWord*8) - 1"
- 		nextPutAll: '# define SHIFT_FOR_WORD 2'; cr; "(BytesPerWord log: 2) rounded"
- 		nextPutAll: '# define SMALL_CONTEXT_SIZE 92'; cr; "ContextFixedSizePlusHeader + 16 * BytesPerWord"
- 		"Large contexts have 56 indexable fileds.  Max with single header word."
- 		"However note that in 64 bits, for now, large contexts have 3-word headers"
- 		nextPutAll: '# define LARGE_CONTEXT_SIZE 252'; cr; "ContextFixedSizePlusHeader + 56 * BytesPerWord."
- 		nextPutAll: '# define SIZE_MASK 0xfc'; cr; "Base header word bit field"
- 		nextPutAll: '# define LONG_SIZE_MASK 0xfffffffc'; cr; "Base header word bit field"
- 		nextPutAll: '# define SIZE_4_BIT 0'; cr;
- 		nextPutAll: '# define MARK_BIT 0x80000000'; cr; "Top bit, 1 bitShift: BytesPerWord*8 - 1"
- 		nextPutAll: '# define ROOT_BIT 0x40000000'; cr; "Next-to-top bit, 1 bitShift: BytesPerWord*8 - 2"
- 		nextPutAll: '# define ALL_BUT_MARK_BIT 0x7fffffff'; cr; "WordMask - MarkBit."
- 		nextPutAll: '# define ALL_BUT_ROOT_BIT 0xbfffffff'; cr; "WordMask - RootBit"
- 		nextPutAll: '# define ALL_BUT_TYPE_MASK 0xfffffffc'; cr; "WordMask - TypeMask"
- 		nextPutAll: '# define ALL_BUT_MARK_BIT_AND_TYPE_MASK 0x7ffffffc'; cr; "AllButTypeMask - MarkBit"
- 		nextPutAll: '# define ALL_BUT_HASH_BITS 0xe001ffff'; cr;
- 
- 		nextPutAll: '#else // 64-bit object memory'; cr;
- 		nextPutAll: '# define WORD_MASK 0xffffffffffffffff'; cr;
- 		nextPutAll: '# define SHIFT_FOR_WORD 3'; cr;
- 		nextPutAll: '# define SMALL_CONTEXT_SIZE 184'; cr;
- 		nextPutAll: '# define LARGE_CONTEXT_SIZE 504'; cr;
- 		nextPutAll: '# define SIZE_MASK 0xf8'; cr; "Lose the 4 bit in temp 64-bit chunk format"
- 		nextPutAll: '# define LONG_SIZE_MASK 0xfffffffffffffff8'; cr;
- 		"The 4 bit is excluded from SIZE_MASK for 64-bit object memory, but need it"
- 		"for ST size, so define SIZE_4_BIT."
- 		nextPutAll: '# define SIZE_4_BIT 4'; cr;
- 		nextPutAll: '# define MARK_BIT 0x8000000000000000'; cr;
- 		nextPutAll: '# define ROOT_BIT 0x4000000000000000'; cr;
- 		nextPutAll: '# define ALL_BUT_MARK_BIT 0x7fffffffffffffff'; cr;
- 		nextPutAll: '# define ALL_BUT_ROOT_BIT 0xbfffffffffffffff'; cr;
- 		nextPutAll: '# define ALL_BUT_TYPE_MASK 0xfffffffffffffffc'; cr;
- 		nextPutAll: '# define ALL_BUT_MARK_BIT_AND_TYPE_MASK 0x7ffffffffffffffc'; cr;
- 		nextPutAll: '# define ALL_BUT_HASH_BITS 0xffffffffe001ffff'; cr;
- 		nextPutAll: '#endif //  (BYTES_PER_WORD == 4)'; cr
- 	
- !

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 removed:
- ----- Method: VMMaker>>for64BitVM (in category 'initialize') -----
- for64BitVM
- "set my flag to make a 64bit pointer model VM"
- 	is64BitVM := true.
- 	self changed: #sourceDirectory.!

Item was removed:
- ----- Method: VMMaker>>isFor32BitVM (in category 'initialize') -----
- isFor32BitVM
- "is my flag to make a 32bit pointer model VM?"
- 	^is64BitVM not!



More information about the Vm-dev mailing list