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

commits at source.squeak.org commits at source.squeak.org
Sat Mar 8 01:18:44 UTC 2014


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

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

Name: VMMaker.oscog-eem.632
Author: eem
Time: 7 March 2014, 5:15:33.482 pm
UUID: 3f0a0718-79cf-45e4-94fe-a0e6e87d19cf
Ancestors: VMMaker.oscog-eem.631

Spur:
Don't write out empty segments on snapshot.

Make various of the segment snapshot i/o rouitnes not inline for
debugging Newspeak bootstrap load crash.

Make segmentContainingObj: avalable for debugging.

Fix assert in inClassTableBitmapSet:.

VMMaker:
don't trample on examplePlugins files.
Report monticello version when blurbing to transcript.

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

Item was added:
+ ----- Method: CCodeGenerator class>>shortMonticelloDescriptionForClass: (in category 'C code generator') -----
+ shortMonticelloDescriptionForClass: aClass
+ 	"Answer a suitable Monticello package stamp to include in a moduleName."
+ 	| mdesc |
+ 	mdesc := [self monticelloDescriptionFor: aClass]
+ 				on: Error
+ 				do: [:ex| ^' ', Date today asString].
+ 	^mdesc copyFrom: 1 to: (mdesc indexOfSubCollection: ' uuid:') - 1!

Item was changed:
  ----- Method: CCodeGenerator>>shortMonticelloDescriptionForClass: (in category 'C code generator') -----
  shortMonticelloDescriptionForClass: aClass
  	"Answer a suitable Monticello package stamp to include in a moduleName."
+ 	^self class shortMonticelloDescriptionForClass: aClass!
- 	| mdesc |
- 	mdesc := [self class monticelloDescriptionFor: aClass]
- 				on: Error
- 				do: [:ex| ^' ', Date today asString].
- 	^mdesc copyFrom: 1 to: (mdesc indexOfSubCollection: ' uuid:') - 1!

Item was changed:
  ----- Method: SpurMemoryManager>>imageSizeToWrite (in category 'snapshot') -----
  imageSizeToWrite
  	"when asked, newSpace should be empty."
  	self assert: self newSpaceIsEmpty.
+ 	^segmentManager totalBytesInNonEmptySegments!
- 	^segmentManager totalBytesInSegments!

Item was changed:
  ----- Method: SpurMemoryManager>>inClassTableBitmapSet: (in category 'class table') -----
  inClassTableBitmapSet: classIndex
  	| bit majorIndex |
+ 	self assert: (classIndex >= self firstClassIndexPun
+ 				 and: [classIndex <= self classIndexMask]).
- 	self assert: (classIndex > self lastClassIndexPun and: [classIndex <= self classIndexMask]).
  	majorIndex := classIndex // BitsPerByte.
  	bit := 1 << (classIndex bitAnd: BitsPerByte - 1).
  	classTableBitmap
  		at: majorIndex
  		put: ((classTableBitmap at: majorIndex) bitOr: bit)!

Item was changed:
  ----- Method: SpurSegmentManager>>adjustSegmentSwizzlesBy: (in category 'snapshot') -----
  adjustSegmentSwizzlesBy: firstSegmentShift
  	"Adjust swizzles by firstSegmentShift.  Also computes segStarts as
  	 they were in the image when it was written, so that oops' segments
  	 can be determined and hence oops correctly swizzled."
  	<inline: false>
+ 	<var: 'segInfo' type: #'SpurSegmentInfo *'>
- 	<var: 'segInfo' type: 'SpurSegmentInfo *'>
  	| oldBaseAddr |
  	oldBaseAddr := manager memoryBaseForImageRead - firstSegmentShift.
  	0 to: numSegments - 1 do:
  		[:i| | segInfo |
  		 segInfo := self addressOf: (segments at: i).
  		 segInfo
  			segStart: segInfo segStart + oldBaseAddr;
  			swizzle: segInfo swizzle - oldBaseAddr].
  	canSwizzle := true!

Item was added:
+ ----- Method: SpurSegmentManager>>nextNonEmptySegmentSizeAfter: (in category 'snapshot') -----
+ nextNonEmptySegmentSizeAfter: i
+ 	"Answer the size of the next non-empty segment.
+ 	 The size of a segment includes that of its bridge.
+ 	 A segment containing just a free object and a bridge will still have a
+ 	 size of manager bridgeSize after shortening it in prepareForSnapshot."
+ 	| nextx |
+ 	nextx := i.
+ 	[(nextx := nextx + 1) >= numSegments ifTrue:
+ 		[^0].
+ 	 (segments at: nextx) segSize > manager bridgeSize ifTrue:
+ 		[^(segments at: nextx) segSize]] repeat!

Item was changed:
  ----- Method: SpurSegmentManager>>prepareForSnapshot (in category 'snapshot') -----
  prepareForSnapshot
  	"shorten all segments by any trailing free space."
+ 	<inline: false>
  	<var: #seg type: #'SpurSegmentInfo *'>
  	0 to: numSegments - 1 do:
  		[:i|
  		 (segments at: i)
  			savedSegSize: (segments at: i) segSize;
  			lastFreeObject: nil].
  
  	"Ideally finding the lastFreeObject of each segment would be
  	 done in some linear pass through the heap.  But for now KISS."
  	manager freeTreeNodesDo:
+ 		[:freeChunk| | node next seg |
+ 		 node := freeChunk.
+ 		 [node ~= 0] whileTrue:
+ 			[next := manager objectAfter: node limit: manager endOfMemory.
+ 			 (manager isSegmentBridge: next)
+ 				ifTrue:
+ 					[seg := self segmentContainingObj: node.
+ 					 seg lastFreeObject: node.
+ 					 node := 0]
+ 				ifFalse:
+ 					[node := self fetchPointer: self freeChunkNextIndex
+ 								ofFreeChunk: node]].
- 		[:freeChunk| | next seg |
- 		 next := manager objectAfter: freeChunk limit: manager endOfMemory.
- 		 (manager isSegmentBridge: next) ifTrue:
- 			[seg := self segmentContainingObj: freeChunk.
- 			 seg lastFreeObject: freeChunk].
  		 freeChunk].
  
  	0 to: numSegments - 1 do:
  		[:i|
  		 (segments at: i) lastFreeObject ifNotNil:
  			[:freeChunk|
  			manager detachFreeObject: freeChunk.
  			(segments at: i)
  				segSize: (manager startOfObject: freeChunk)
  						+ manager bridgeSize
  						- (segments at: i) segStart.
  			self bridgeFrom: (self addressOf: (segments at: i))
  				to: (i < (numSegments - 1) ifTrue: [self addressOf: (segments at: i + 1)])]].
  
  	"perhaps this should read
  		manager setEndOfMemory: 0; assimilateNewSegment: (segments at: numSegments - 1)"
  	manager setEndOfMemory: (segments at: numSegments - 1) segLimit - manager bridgeSize!

Item was changed:
  ----- Method: SpurSegmentManager>>readHeapFromImageFile:dataBytes: (in category 'snapshot') -----
  readHeapFromImageFile: f dataBytes: numBytes
  	"Read numBytes of image data from f into memory at memoryBaseForImageRead.
  	 Answer the number of bytes written.  In addition, read each segment, build up the
  	 segment info, while eliminating the bridge objects that end each segment and
  	 give the size of the subsequent segment."
  	<var: #f type: #sqImageFile>
  	<inline: false>
  	| bytesRead totalBytesRead bridge nextSegmentSize oldBase newBase segInfo bridgeSpan |
+ 	<var: 'segInfo' type: #'SpurSegmentInfo *'>
- 	<var: 'segInfo' type: 'SpurSegmentInfo *'>
  	self allocateOrExtendSegmentInfos.
  
  	"segment sizes include the two-header-word bridge at the end of each segment."
  	numSegments := totalBytesRead := 0.
  	oldBase := 0. "N.B. still must be adjusted by oldBaseAddr."
  	newBase := manager oldSpaceStart.
  	nextSegmentSize := firstSegmentSize.
  	bridge := firstSegmentSize + manager oldSpaceStart - manager baseHeaderSize.
  	[segInfo := self addressOf: (segments at: numSegments).
  	 segInfo
  		segStart: oldBase;					"N.B. still must be adjusted by oldBaseAddr."
  		segSize: nextSegmentSize;
  		swizzle: newBase - oldBase.	"N.B. still must be adjusted by oldBaseAddr."
  	 bytesRead := self readHeapFrom: f at: newBase dataBytes: nextSegmentSize.
  	 bytesRead > 0 ifTrue:
  			[totalBytesRead := totalBytesRead + bytesRead].
  	 bytesRead ~= nextSegmentSize ifTrue:
  		[^totalBytesRead].
  	 numSegments := numSegments + 1.
  	 bridgeSpan := manager bytesPerSlot * (manager rawOverflowSlotsOf: bridge).
  	 oldBase := oldBase + nextSegmentSize + bridgeSpan.
  	 newBase := newBase + nextSegmentSize - manager bridgeSize.
  	 nextSegmentSize := manager longLongAt: bridge.
  	 nextSegmentSize ~= 0] whileTrue:
  		[bridge := bridge - manager bridgeSize + nextSegmentSize].
  	"newBase should point just past the last bridge. all others should have been eliminated."
  	self assert: newBase - manager oldSpaceStart
  				= (totalBytesRead - (numSegments * manager bridgeSize)).
  	"set freeOldSpaceStart now for adjustAllOopsBy:"
  	manager setFreeOldSpaceStart: newBase.
  	"we're done. nil firstSegmentSize for a subsequent snapshot."
  	firstSegmentSize := nil.
  	^totalBytesRead!

Item was changed:
  ----- Method: SpurSegmentManager>>segmentContainingObj: (in category 'accessing') -----
  segmentContainingObj: objOop
+ 	<export: true>
  	<returnTypeC: #'SpurSegmentInfo *'>
  	numSegments - 1 to: 0 by: -1 do:
  		[:i|
  		objOop >= (segments at: i) segStart ifTrue:
  			[^self addressOf: (segments at: i)]].
  	^nil!

Item was added:
+ ----- Method: SpurSegmentManager>>totalBytesInNonEmptySegments (in category 'snapshot') -----
+ totalBytesInNonEmptySegments
+ 	| total |
+ 	total := 0.
+ 	0 to: numSegments - 1 do:
+ 		[:i|
+ 		(segments at: i) segSize > manager bridgeSize ifTrue:
+ 			[total := total + (segments at: i) segSize]].
+ 	^total!

Item was changed:
  ----- Method: SpurSegmentManager>>writeImageToFile: (in category 'snapshot') -----
  writeImageToFile: aBinaryStream
+ 	<var: 'aBinaryStream' type: #'FILE *'>
+ 	<inline: false>
  	| total |
- 	total := 0.
  	self assert: (manager endOfMemory = (segments at: numSegments - 1) segLimit
  				 or: [manager endOfMemory + manager bridgeSize = (segments at: numSegments - 1) segLimit]).
  	firstSegmentSize ifNotNil:
  		[self assert: firstSegmentSize = (segments at: 0) segSize].
+ 	self assert: (segments at: 0) segSize > 0.
+ 	total := 0.
  	0 to: numSegments - 1 do:
+ 		[:i|
+ 		(segments at: i) segSize > manager bridgeSize ifTrue:
+ 			[total := total + (self writeSegment: (self addressOf: (segments at: i))
+ 								nextSegmentSize: (self nextNonEmptySegmentSizeAfter: i)
+ 								toFile: aBinaryStream)]].
- 		[:i| | nextSegSize |
- 		nextSegSize := i = (numSegments - 1)
- 							ifTrue: [0]
- 							ifFalse: [(segments at: i + 1) segSize].
- 		total := total + (self writeSegment: (self addressOf: (segments at: i))
- 							nextSegmentSize: nextSegSize
- 							toFile: aBinaryStream)].
  	^total!

Item was changed:
  ----- Method: VMMaker>>generateEntire (in category 'generate sources') -----
  generateEntire
  	"Generate the interp, internal plugins and exports as well as the external plugins.
  	 If this comes from a generator, log it for convenience."
  	self configurationGeneratorNameOrNil ifNotNil:
  		[:generator|
  		 logger cr; nextPutAll: (generator selector copyReplaceAll: 'generate' with: '').
+ 		 interpreterClassName ifNotNil:
+ 			[logger
+ 				space; nextPutAll: interpreterClassName;
+ 				space; nextPutAll: (CCodeGenerator shortMonticelloDescriptionForClass: interpreterClassName)].
- 		 interpreterClassName ifNotNil: [logger space; nextPutAll: interpreterClassName].
  		 logger cr; flush].
  	self generateMainVM.
  	self generateExternalPlugins!

Item was changed:
  ----- Method: VMMaker>>storeExternalPluginList (in category 'exports') -----
  storeExternalPluginList
  	| contents filePath fileStream |
+ 	((self externalPluginListName beginsWith: 'example')
+ 	 and: [self makefileDirectory fileExists: self externalPluginListName]) ifTrue:
+ 		[^self].
  	contents := String streamContents:
  		[:s|
  		s nextPutAll:'# Automatically generated makefile include for external plugins'.
  		s cr; nextPutAll:'EXTERNAL_PLUGINS ='.
  		self externalPluginsDo:
  			[:cls|
  			s space; nextPut: $\; cr; nextPutAll: cls moduleName].
  		s cr].
  	filePath := self makefileDirectory fullNameFor: self externalPluginListName.
  	(CCodeGenerator basicNew needToGenerateHeader: filePath file: filePath contents: contents) ifTrue:
  		[[fileStream := VMMaker forceNewFileNamed: filePath] 
  			on: FileDoesNotExistException 
  			do:[^self couldNotOpenFile: filePath].
  		 fileStream nextPutAll: contents; close]!

Item was changed:
  ----- Method: VMMaker>>storeInternalPluginList (in category 'exports') -----
  storeInternalPluginList
  	| contents filePath fileStream |
+ 	((self internalPluginListName beginsWith: 'example')
+ 	 and: [self makefileDirectory fileExists: self internalPluginListName]) ifTrue:
+ 		[^self].
  	contents := String streamContents:
  		[:s|
  		s nextPutAll:'# Automatically generated makefile include for internal plugins'.
  		s cr; nextPutAll:'INTERNAL_PLUGINS ='.
  		self internalPluginsDo:
  			[:cls|
  			s space; nextPut: $\; cr; nextPutAll: cls moduleName].
  		s cr].
  	filePath := self makefileDirectory fullNameFor: self internalPluginListName.
  	(CCodeGenerator basicNew needToGenerateHeader: filePath file: filePath contents: contents) ifTrue:
  		[[fileStream := VMMaker forceNewFileNamed: filePath] 
  			on: FileDoesNotExistException 
  			do:[^self couldNotOpenFile: filePath].
  		 fileStream nextPutAll: contents; close]!



More information about the Vm-dev mailing list