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

commits at source.squeak.org commits at source.squeak.org
Fri Dec 13 20:51:03 UTC 2013


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

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

Name: VMMaker.oscog-eem.562
Author: eem
Time: 13 December 2013, 12:48:33.563 pm
UUID: c612f6db-7bbc-4c69-86e4-65b2a90de879
Ancestors: VMMaker.oscog-eem.561

Generate better code for Spur's getInlineCacheClassTagFrom:into:.

Refactor followNecessaryForwardingInMethod: to only compute the
literal count once and, in Cog, to use the cmUsesMethodClass flag
to avoid following methods without a super send anyway.

Avoid following methodClass if not an Association (e.g. Newspeak).

Fix SpurMemMgr>>firstIndexableField:

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

Item was changed:
  ----- Method: CoInterpreter>>actuallyFollowNecessaryForwardingInMethod: (in category 'lazy become') -----
  actuallyFollowNecessaryForwardingInMethod: methodObj
+ 	"To avoid any chance of a forwarded object during super sends
+ 	 we follow the methodClassAssociation.  The forwarded object
+ 	 send fault only copes with normal sends to instances."
+ 	| cogMethod header litCount |
- 	"To avoid any chance of a forwarded object during super sends we follow the
- 	 methodClassAssociation.  The forwarded object send fault only copes with
- 	 normal sends to instances."
- 	| cogMethod header |
  	<var: #cogMethod type: #'CogMethod *'>
- 	super actuallyFollowNecessaryForwardingInMethod: methodObj.
  	header := self rawHeaderOf: methodObj.
  	(self isCogMethodReference: header) ifTrue:
  		[cogMethod := self cCoerceSimple: header to: #'CogMethod *'.
+ 		 "If the method class is not used we can avoid the forwarding
+ 		  check for both the cogMehod and the bytecoded method."
+ 		 cogMethod cmUsesMethodClass ifFalse:
+ 			[^self].
+ 		 cogit followForwardedLiteralsIn: cogMethod.
+ 		 header := cogMethod methodHeader].
+ 	litCount := self literalCountOfHeader: header. "Slang super expansion limitation"
+ 	super
+ 		actuallyFollowNecessaryForwardingInMethod: methodObj
+ 		literalCount: litCount!
- 		 cogMethod cmUsesMethodClass ifTrue:
- 			[cogit followForwardedLiteralsIn: cogMethod]]!

Item was changed:
  ----- Method: CoInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
  readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
  	"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
  	"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
  	"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
  
  	| swapBytes headerStart headerSize dataSize oldBaseAddr
  	  minimumMemory heapSize bytesRead bytesToShift firstSegSize
  	  hdrNumStackPages hdrEdenBytes hdrCogCodeSize headerFlags hdrMaxExtSemTabSize |
  	<var: #f type: #sqImageFile>
  	<var: #dataSize type: #'size_t'>
  	<var: #desiredHeapSize type: #usqInt>
  	<var: #headerStart type: #squeakFileOffsetType>
  	<var: #imageOffset type: #squeakFileOffsetType>
  
  	metaclassNumSlots := 6.	"guess Metaclass instSize"
  	classNameIndex := 6.		"guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1"
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  	headerStart := (self sqImageFilePosition: f) - BytesPerWord.  "record header start position"
  
  	headerSize			:= self getLongFromFile: f swap: swapBytes.
  	dataSize			:= self getLongFromFile: f swap: swapBytes.
  	oldBaseAddr		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  	objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B.  not used."
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	headerFlags			:= self getLongFromFile: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	extraVMMemory		:= self getLongFromFile: f swap: swapBytes. "N.B.  not used."
  	hdrNumStackPages	:= self getShortFromFile: f swap: swapBytes.
  	"4 stack pages is small.  Should be able to run with as few as
  	 three. 4 should be comfortable but slow.  8 is a reasonable
  	 default.  Can be changed via vmParameterAt: 43 put: n.
  	 Can be set as a preference (Info.plist, VM.ini, command line etc).
  	 If desiredNumStackPages is already non-zero then it has been
  	 set as a preference.  Ignore (but preserve) the header's default."
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	"This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
  	hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
  	cogCodeSize := desiredCogCodeSize ~= 0
  						ifTrue: [desiredCogCodeSize]
  						ifFalse:
  							[hdrCogCodeSize = 0
  									ifTrue: [self defaultCogCodeSize]
  									ifFalse: [hdrCogCodeSize]].
  	hdrEdenBytes		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory edenBytes: (desiredEdenBytes ~= 0
  						ifTrue: [desiredEdenBytes]
  						ifFalse:
  							[hdrEdenBytes = 0
  									ifTrue: [objectMemory defaultEdenBytes]
  									ifFalse: [hdrEdenBytes]]).
  	desiredEdenBytes := hdrEdenBytes.
  	hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
  	hdrMaxExtSemTabSize ~= 0 ifTrue:
  		[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 Preserve it to be polite to other VMs."
  	the2ndUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	firstSegSize := self getLongFromFile: f swap: swapBytes.
  	objectMemory firstSegmentSize: firstSegSize.
  
  	"compare memory requirements with availability"
  	minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed"
  						+ dataSize
  						+ objectMemory newSpaceBytes
  						+ self interpreterAllocationReserveBytes.
  	heapSize             :=  cogCodeSize "no need to include the stackZone; this is alloca'ed"
  						+ desiredHeapSize
+ 						+ objectMemory newSpaceBytes
- 						"+ edenBytes" "don't include edenBytes; this is part of the heap and so part of desiredHeapSize"
  						+ self interpreterAllocationReserveBytes.
  	heapSize < minimumMemory ifTrue:
  		[self insufficientMemorySpecifiedError].
  
  	"allocate a contiguous block of memory for the Squeak heap and ancilliary data structures"
  	objectMemory memory: (self
  								allocateMemory: heapSize
  								minimum: minimumMemory
  								imageFile: f
  								headerSize: headerSize) asUnsignedInteger.
  	objectMemory memory ifNil: [self insufficientMemoryAvailableError].
  
  	heapBase := objectMemory
  					setHeapBase: objectMemory memory + cogCodeSize
+ 					memoryLimit: objectMemory memory + heapSize
- 					memoryLimit: objectMemory memory + cogCodeSize + heapSize
  					endOfMemory: objectMemory memory + cogCodeSize + dataSize.
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	"compute difference between old and new memory base addresses"
  	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	self initializeCodeGenerator.
  	^dataSize!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>getInlineCacheClassTagFrom:into: (in category 'compile abstract instructions') -----
  getInlineCacheClassTagFrom: sourceReg into: destReg
  	"Extract the inline cache tag for the object in sourceReg into destReg. The inline
  	 cache tag for a given object is the value loaded in inline caches to distinguish
  	 objects of different classes.  In Spur this is either the tags for immediates, (with
  	 1 & 3 collapsed to 1 for SmallIntegers, and 2 collapsed to 0 for Characters), or
  	 the receiver's classIndex.  Generate something like this:
+ 		Lentry:
+ 			movl rSource, rDest
+ 			andl $0x3, rDest
+ 			jz LnotImm
+ 			andl $1, rDest
+ 			j Lcmp
+ 		LnotImm:
+ 			movl 0(%edx), rDest
+ 			andl $0x3fffff, rDest
+ 		Lcmp:
+ 	 At least on a 2.2GHz Intel Core i7 it is slightly faster,
+ 	 136m sends/sec vs 130m sends/sec for nfib in tinyBenchmarks, than
  		Limm:
  			andl $0x1, rDest
  			j Lcmp
  		Lentry:
  			movl rSource, rDest
  			andl $0x3, rDest
  			jnz Limm
  			movl 0(%edx), rDest
  			andl $0x3fffff, rDest
+ 		Lcmp:
- 		Lcmp
  	"
+ 	| jumpNotImm entryLabel jumpCompare |
+ 	<var: #jumpNotImm type: #'AbstractInstruction *'>
- 	| immLabel entryLabel jumpCompare |
- 	<var: #immLabel type: #'AbstractInstruction *'>
  	<var: #entryLabel type: #'AbstractInstruction *'>
  	<var: #jumpCompare type: #'AbstractInstruction *'>
+ 	cogit AlignmentNops: (BytesPerWord max: 8).
- 	cogit AlignmentNops: BytesPerWord.
- 	immLabel := cogit Label.
- 	cogit AndCq: 1 R: destReg.
- 	jumpCompare := cogit Jump: 0.
- 	cogit AlignmentNops: BytesPerWord.
  	entryLabel := cogit Label.
  	cogit MoveR: sourceReg R: destReg.
  	cogit AndCq: objectMemory tagMask R: destReg.
+ 	jumpNotImm := cogit JumpZero: 0.
+ 	cogit AndCq: 1 R: destReg.
+ 	jumpCompare := cogit Jump: 0.
- 	cogit JumpNonZero: immLabel.
- 	self flag: #endianness.
  	"Get least significant half of header word in destReg"
+ 	self flag: #endianness.
+ 	jumpNotImm jmpTarget:
+ 		(cogit MoveMw: 0 r: sourceReg R: destReg).
+ 	jumpCompare jmpTarget:
+ 		(cogit AndCq: objectMemory classIndexMask R: destReg).
- 	cogit MoveMw: 0 r: sourceReg R: destReg.
- 	cogit AndCq: objectMemory classIndexMask R: destReg.
- 	jumpCompare jmpTarget: cogit Label.
  	^entryLabel!

Item was changed:
  ----- Method: SpurMemoryManager>>firstIndexableField: (in category 'object format') -----
  firstIndexableField: objOop
  	"NOTE: overridden in various simulator subclasses to add coercion to CArray, so please duplicate any changes.
  	 There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
  	 The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
  	 of the object).  For 3 we must go to the class."
  	| fmt classFormat |
  	<returnTypeC: #'void *'>
  	fmt := self formatOf: objOop.
+ 	fmt <= self weakArrayFormat ifTrue:
+ 		[fmt = self arrayFormat ifTrue: "array starts at 0."
+ 			[^self pointerForOop: objOop + self baseHeaderSize].
+ 		 fmt >= self indexablePointersFormat ifTrue: "indexable with inst vars; need to delve into the class format word"
- 	fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
- 		[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
  			[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
  			 ^self pointerForOop: objOop
  								+ self baseHeaderSize
  								+ ((self fixedFieldsOfClassFormat: classFormat) << self wordSize)].
+ 		 "otherwise not indexable"
+ 		 ^0].
- 		^self pointerForOop: objOop
- 							+ self baseHeaderSize
- 							+ ((self numSlotsOf: objOop) << self wordSize)].
  	"All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
+ 	(fmt >= self sixtyFourBitIndexableFormat
+ 	 and: [fmt < self firstCompiledMethodFormat]) ifTrue:
+ 		[^self pointerForOop: objOop + self baseHeaderSize].
+ 	"otherwise not indexable"
+ 	^0!
- 	self assert: fmt < self firstCompiledMethodFormat.
- 	^self pointerForOop: objOop + self baseHeaderSize!

Item was changed:
  ----- Method: StackInterpreter>>actuallyFollowNecessaryForwardingInMethod: (in category 'lazy become') -----
  actuallyFollowNecessaryForwardingInMethod: methodObj
  	"To avoid any chance of a forwarded object during super sends we follow the
  	 methodClassAssociation.  The forwarded object send fault only copes with
  	 normal sends to instances."
- 	| assoc classObj |
  	<option: #SpurObjectMemory>
  	<inline: true>
+ 	self actuallyFollowNecessaryForwardingInMethod: methodObj
+ 		literalCount: (self literalCountOf: methodObj)!
- 	assoc := self methodClassAssociationOf: methodObj.
- 	(objectMemory isForwarded: assoc) ifTrue:
- 		[assoc := objectMemory followForwarded: assoc.
- 		 self setMethodClassAssociationOf: methodObj to: assoc].
- 	classObj := objectMemory fetchPointer: ValueIndex ofObject: assoc.
- 	(objectMemory isForwarded: classObj) ifTrue:
- 		[classObj := objectMemory followForwarded: assoc.
- 		 objectMemory storePointer: ValueIndex ofObject: assoc withValue: classObj]!

Item was added:
+ ----- Method: StackInterpreter>>actuallyFollowNecessaryForwardingInMethod:literalCount: (in category 'lazy become') -----
+ actuallyFollowNecessaryForwardingInMethod: methodObj literalCount: litCount
+ 	"To avoid any chance of a forwarded object during super sends we follow the
+ 	 methodClassAssociation.  The forwarded object send fault only copes with
+ 	 normal sends to instances.  Inline methodClassAssociation access for speed."
+ 	| assoc classObj |
+ 	<option: #SpurObjectMemory>
+ 	<inline: true>
+ 	assoc := self literal: litCount - 1 ofMethod: methodObj.
+ 	(objectMemory isForwarded: assoc) ifTrue:
+ 		[assoc := objectMemory followForwarded: assoc.
+ 		 objectMemory
+ 			storePointer: litCount + LiteralStart - 1
+ 			ofObject: methodObj
+ 			withValue: assoc].
+ 	(objectMemory numSlotsOf: assoc) >= (ValueIndex + 1) ifTrue:
+ 		[classObj := objectMemory fetchPointer: ValueIndex ofObject: assoc.
+ 		 (objectMemory isForwarded: classObj) ifTrue:
+ 			[classObj := objectMemory followForwarded: assoc.
+ 			 objectMemory storePointer: ValueIndex ofObject: assoc withValue: classObj]]!



More information about the Vm-dev mailing list