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

commits at source.squeak.org commits at source.squeak.org
Thu Oct 10 19:26:30 UTC 2013


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

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

Name: VMMaker.oscog-eem.448
Author: eem
Time: 10 October 2013, 12:23:29.205 pm
UUID: 772830f8-5ae6-4601-8cc1-e576d1dd6cbb
Ancestors: VMMaker.oscog-eem.447

Commit incomplete Spur image loading at a decision point.  Do we
load the image in one go and free the bridges in between segments,
or do we read the image a segment at a time and squeeze out the
bridges?  The issue is that if bridges are freed they must be at least
3 allocation unts long, whereas if they don't have to be freed they
can be two allocationUnits long.

Change the image loaders (both real and simulated) to
- tell objectmemory what the firstSegmentSize is
- use newSpaceBytes instead of edenBytes, alloing Spur to include
  survivor space sizes.
- use memoryBaseForImageRead instead of startOfMemory so Spur
  can read heap above newSpace.
- use sq:Image:File:Read: in place of cCode: 'sqImage...'

Change the simulated loaders to use getLongFromFile:swap: &
getShortFromFile:swap: since it was confusing to have to use
nextLongFrom:swap: & nextShortFrom:swap: as the get... ones didn't
advance the file pointer.

Refactor numSlotsOf: into rawNumSlotsOf: and overflowSlotsOf:.

SpurSegmentManager parses segments in the loaded image,
computing segment sizes and offsets and building up segment info.
adjustAllOopsBy: asks the segment manager to swizzle.
Also have to swizzle free chunks and the freeLists object.

Revert initializeOldSpaceFirstFree:; the segment manager creates the
last bridge.

Nuke unused oopOfObjectStartingAt: & overflowSlotsMask.

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

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
+ 	  hdrNumStackPages hdrEdenBytes hdrCogCodeSize headerFlags hdrMaxExtSemTabSize firstSegSize |
- 	  hdrNumStackPages hdrEdenBytes hdrCogCodeSize headerFlags hdrMaxExtSemTabSize |
  	<var: #f type: 'sqImageFile '>
  	<var: #memStart type: 'usqInt'>
  	<var: #desiredHeapSize type: 'usqInt'>
  	<var: #headerStart type: 'squeakFileOffsetType '>
  	<var: #dataSize type: 'size_t '>
  	<var: #imageOffset type: 'squeakFileOffsetType '>
  
  	metaclassSizeBits := 6 * BytesPerWord.	"guess (Metaclass instSize * BPW)"
  	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 nextLongFrom: 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
- 						+ objectMemory edenBytes
  						+ self interpreterAllocationReserveBytes.
  	heapSize             :=  cogCodeSize "no need to include the stackZone; this is alloca'ed"
  						+ desiredHeapSize
  						"+ 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"
- 	"N.B. If the platform needs to it will redefine this macro to make heapSize
- 	 an in/out parameter and assign the ammount actually allocated into heapSize.
- 	 See e.g. platforms/Mac OS/vm/sqPlatformSpecific.h.  (I *hate* this. eem 7/23/2009)"
- 	"objectMemory memory: (self cCode: 'sqAllocateMemory(minimumMemory, heapSize)').  "
  	objectMemory memory: (self
  								allocateMemory: heapSize
  								minimum: minimumMemory
  								imageFile: f
  								headerSize: headerSize) asUnsignedInteger.
  	
  	objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
  	heapBase := objectMemory memory + cogCodeSize.
  	self assert: objectMemory startOfMemory = heapBase.
  	objectMemory
  		setHeapBase: heapBase
  		memoryLimit: objectMemory memory + heapSize - 24  "decrease memoryLimit a tad for safety (?!!?!!? eem eem 10/9/2013 15:15)"
  		endOfMemory: heapBase + 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 := self
+ 					sq: (self pointerForOop: objectMemory memoryBaseForImageRead)
+ 					Image: (self sizeof: #char)
+ 					File: dataSize
+ 					Read: f.
- 	bytesRead := self cCode: 'sqImageFileRead(pointerForOop(heapBase), sizeof(unsigned char), dataSize, f)'.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	"compute difference between old and new memory base addresses"
+ 	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
- 	bytesToShift := heapBase - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	self initializeCodeGenerator.
  	^dataSize!

Item was added:
+ ----- Method: CogVMSimulator>>getLongFromFile:swap: (in category 'initialization') -----
+ getLongFromFile: aStream swap: swapFlag
+ 	^swapFlag 
+ 		ifTrue: [objectMemory byteSwapped: (self nextLongFrom: aStream)]
+ 		ifFalse: [self nextLongFrom: aStream]!

Item was added:
+ ----- Method: CogVMSimulator>>getShortFromFile:swap: (in category 'image save/restore') -----
+ getShortFromFile: aFile swap: swapFlag
+ 	| aShort |
+ 	aShort := self nextShortFrom: aFile.
+ 	^swapFlag 
+ 		ifTrue: [(aShort bitShift: -8) + ((aShort bitAnd: 16rFF) bitShift: 8)]
+ 		ifFalse: [aShort]!

Item was removed:
- ----- Method: CogVMSimulator>>nextLongFrom:swap: (in category 'initialization') -----
- nextLongFrom: aStream swap: swapFlag
- 	swapFlag 
- 		ifTrue: [^ objectMemory byteSwapped: (self nextLongFrom: aStream)]
- 		ifFalse: [^ self nextLongFrom: aStream]!

Item was removed:
- ----- Method: CogVMSimulator>>nextShortFrom:swap: (in category 'initialization') -----
- nextShortFrom: aStream swap: swapFlag
- 	| aShort |
- 	aShort := self nextShortFrom: aStream.
- 	^swapFlag 
- 		ifTrue: [(aShort bitShift: -8) + ((aShort bitAnd: 16rFF) bitShift: 8)]
- 		ifFalse: [aShort]!

Item was changed:
  ----- Method: CogVMSimulator>>openOn:extraMemory: (in category 'initialization') -----
  openOn: fileName extraMemory: extraBytes
  	"CogVMSimulator new openOn: 'clone.im' extraMemory: 100000"
  
  	| f version headerSize count heapSize oldBaseAddr bytesToShift swapBytes hdrNumStackPages
+ 	 hdrEdenBytes hdrCogCodeSize stackZoneSize methodCacheSize headerFlags primTraceLogSize firstSegSize hdrMaxExtSemTabSize |
- 	 hdrEdenBytes hdrCogCodeSize stackZoneSize methodCacheSize headerFlags primTraceLogSize |
  	"open image file and read the header"
  
  	["begin ensure block..."
  	f := FileStream readOnlyFileNamed: fileName.
  	imageName := f fullName.
  	f binary.
  	version := self nextLongFrom: f.  "current version: 16r1968 (=6504) vive la revolucion!!"
  	(self readableFormat: version)
  		ifTrue: [swapBytes := false]
  		ifFalse: [(version := objectMemory byteSwapped: version) = self imageFormatVersion
  					ifTrue: [swapBytes := true]
  					ifFalse: [self error: 'incomaptible image format']].
+ 	headerSize := self getLongFromFile: f swap: swapBytes.
+ 	heapSize := self getLongFromFile: f swap: swapBytes.  "length of heap in file"
+ 	oldBaseAddr := self getLongFromFile: f swap: swapBytes.  "object memory base address of image"
+ 	objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
+ 	objectMemory lastHash: (self getLongFromFile: f swap: swapBytes).  "Should be loaded from, and saved to the image header"
- 	headerSize := self nextLongFrom: f swap: swapBytes.
- 	heapSize := self nextLongFrom: f swap: swapBytes.  "length of heap in file"
- 	oldBaseAddr := self nextLongFrom: f swap: swapBytes.  "object memory base address of image"
- 	objectMemory specialObjectsOop: (self nextLongFrom: f swap: swapBytes).
- 	objectMemory lastHash: (self nextLongFrom: f swap: swapBytes).  "Should be loaded from, and saved to the image header"
  
+ 	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
+ 	headerFlags		:= self getLongFromFile: f swap: swapBytes.
- 	savedWindowSize	:= self nextLongFrom: f swap: swapBytes.
- 	headerFlags			:= self nextLongFrom: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
+ 	extraVMMemory	:= self getLongFromFile: f swap: swapBytes.
+ 	hdrNumStackPages	:= self getShortFromFile: f swap: swapBytes.
- 	extraVMMemory		:= self nextLongFrom: f swap: swapBytes.
- 	hdrNumStackPages	:= self nextShortFrom: 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"
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	stackZoneSize := self computeStackZoneSize.
  	"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]].
  	desiredCogCodeSize := hdrCogCodeSize.
+ 	self assert: f position = 40.
+ 	hdrEdenBytes	:= self getLongFromFile: f swap: swapBytes.
- 	hdrEdenBytes	:= self nextLongFrom: 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.
+ 	self assert: f position = 48.
+ 	firstSegSize := self getLongFromFile: f swap: swapBytes.
+ 	objectMemory firstSegmentSize: firstSegSize.
  	"For Open PICs to be able to probe the method cache during
  	 simulation the methodCache must be relocated to memory."
  	methodCacheSize := methodCache size * BytesPerWord.
  	primTraceLogSize := primTraceLog size * BytesPerWord.
  	"allocate interpreter memory. This list is in address order, low to high.
  	 In the actual VM the stack zone exists on the C stack."
  	heapBase := cogCodeSize
  				+ stackZoneSize
  				+ methodCacheSize
  				+ primTraceLogSize
  				+ self rumpCStackSize.
  	objectMemory
  		setHeapBase: heapBase
  		memoryLimit:  heapBase
  						+ heapSize
+ 						+ objectMemory newSpaceBytes
- 						+ objectMemory edenBytes
  						+ self interpreterAllocationReserveBytes
  						+ extraBytes
  		endOfMemory: heapBase + heapSize.
  
  	objectMemory initialize.
  	self assert: cogCodeSize \\ 4 = 0.
  	self assert: objectMemory memoryLimit \\ 4 = 0.
  	self assert: self rumpCStackSize \\ 4 = 0.
  	"read in the image in bulk, then swap the bytes if necessary"
  	f position: headerSize.
  	objectMemory memory: ((cogit processor endianness == #little
  					ifTrue: [LittleEndianBitmap]
  					ifFalse: [Bitmap]) new: objectMemory memoryLimit // 4).
+ 	count := f	readInto: objectMemory memory
+ 				startingAt: objectMemory memoryBaseForImageRead // 4 + 1
+ 				count: heapSize // 4.
- 	count := f readInto: objectMemory memory startingAt: heapBase // 4 + 1 count: heapSize // 4.
  	count ~= (heapSize // 4) ifTrue: [self halt].
  	]
  		ensure: [f close].
  	self moveMethodCacheToMemoryAt: cogCodeSize + stackZoneSize.
  	self movePrimTraceLogToMemoryAt: cogCodeSize + stackZoneSize + methodCacheSize.
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
+ 	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.  "adjust pointers for zero base address"
- 	bytesToShift := objectMemory startOfMemory - oldBaseAddr.  "adjust pointers for zero base address"
  	Utilities
  		informUser: 'Relocating object pointers...'
  		during: [self initializeInterpreter: bytesToShift].
  	self initializeCodeGenerator!

Item was added:
+ ----- Method: NewCoObjectMemory>>memoryBaseForImageRead (in category 'image save/restore') -----
+ memoryBaseForImageRead
+ 	"Answer the address to read the image into."
+ 	^coInterpreter heapBase!

Item was added:
+ ----- Method: NewObjectMemory>>newSpaceBytes (in category 'accessing') -----
+ newSpaceBytes
+ 	^self edenBytes!

Item was removed:
- ----- Method: ObjectMemory>>endOfMemory: (in category 'accessing') -----
- endOfMemory: aValue
- 	^endOfMemory := aValue!

Item was added:
+ ----- Method: ObjectMemory>>firstSegmentSize: (in category 'image save/restore') -----
+ firstSegmentSize: firstSegSize
+ 	"Ignored; this is for Spur's segmented image"!

Item was added:
+ ----- Method: ObjectMemory>>memoryBaseForImageRead (in category 'image save/restore') -----
+ memoryBaseForImageRead
+ 	"Answer the address to read the image into."
+ 	^memory!

Item was removed:
- ----- Method: Spur32BitCoMemoryManager>>edenBytes (in category 'accessing') -----
- edenBytes
- 	"during snapshot load newSpaceLimit holds newSpace size + cogCodeSize temporarily."
- 	scavenger eden limit ifNil:
- 		[| newSpaceBytes |
- 		 newSpaceBytes := newSpaceLimit - coInterpreter cogCodeSize - coInterpreter interpreterAllocationReserveBytes.
- 		 ^newSpaceBytes * self scavengerDenominator - self numSurvivorSpaces // self scavengerDenominator
- 			roundTo: self allocationUnit].
- 	"once initialized we can query the actual beast."
- 	^scavenger eden limit - scavenger eden start!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>newSpaceBytes (in category 'accessing') -----
+ newSpaceBytes
+ 	"during snapshot load newSpaceLimit holds newSpace size + cogCodeSize temporarily."
+ 	^newSpaceLimit - coInterpreter cogCodeSize - coInterpreter interpreterAllocationReserveBytes!

Item was removed:
- ----- Method: Spur32BitMemoryManager>>numSlotsOf: (in category 'object access') -----
- numSlotsOf: objOop
- 	<returnTypeC: #usqInt>
- 	| numSlots |
- 	self flag: #endianness.
- 	"numSlotsOf: should not be applied to free or forwarded objects."
- 	self assert: (self classIndexOf: objOop) > self isForwardedObjectClassIndexPun.
- 	numSlots := self rawNumSlotsOf: objOop..
- 	^numSlots = self numSlotsMask	"overflow slots; (2^32)-1 slots are plenty"
- 		ifTrue: [self longAt: objOop - self baseHeaderSize]
- 		ifFalse: [numSlots]!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>rawNumSlotsOf: (in category 'object access') -----
  rawNumSlotsOf: objOop
  	<returnTypeC: #usqInt>
  	<inline: true>
  	self flag: #endianness.
+ 	^(self longAt: objOop + 4) asUnsignedInteger >> self numSlotsHalfShift!
- 	^(self longAt: objOop + 4) >> self numSlotsHalfShift bitAnd: self numSlotsMask!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>rawOverflowSlotsOf: (in category 'object access') -----
+ rawOverflowSlotsOf: objOop
+ 	<returnTypeC: #usqInt>
+ 	<inline: true>
+ 	self flag: #endianness.
+ 	^self longAt: objOop - self baseHeaderSize!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>reInitSegmentBridge: (in category 'segments') -----
+ reInitSegmentBridge: bridgeOop
+ 	"On image write the segment manager replaces the header of the bridge
+ 	 with the size of the following segment.  This method restores that header."
+ 	<var: #numBytes type: #usqLong>
+ 	self longAt: bridgeOop put: (1 << self pinnedBitShift)
+ 								+ (self wordIndexableFormat << self formatShift)
+ 								+ self segmentBridgePun;
+ 			longAt: bridgeOop + 4 put: self numSlotsMask << self numSlotsHalfShift!

Item was removed:
- ----- Method: Spur64BitMemoryManager>>numSlotsOf: (in category 'object access') -----
- numSlotsOf: objOop
- 	<returnTypeC: #usqLong>
- 	| numSlots |
- 	self flag: #endianness.
- 	"numSlotsOf: should not be applied to free or forwarded objects."
- 	self assert: (self classIndexOf: objOop) > self isForwardedObjectClassIndexPun.
- 	numSlots := self rawNumSlotsOf: objOop..
- 	^numSlots = self numSlotsMask	"overflow slots; (2^56)-1 slots are plenty"
- 		ifTrue: [((self longAt: objOop - self baseHeaderSize) << 8) asUnsignedLong >> 8]
- 		ifFalse: [numSlots]!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>rawOverflowSlotsOf: (in category 'object access') -----
+ rawOverflowSlotsOf: objOop
+ 	<returnTypeC: #usqLong>
+ 	<inline: true>
+ 	self flag: #endianness.
+ 	^((self longAt: objOop - self baseHeaderSize) << 8) asUnsignedLong >> 8!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>reInitSegmentBridge: (in category 'segments') -----
+ reInitSegmentBridge: bridgeOop
+ 	"On image write the segment manager replaces the header of the bridge
+ 	 with the size of the following segment.  This method restores that header."
+ 	self longAt: bridgeOop
+ 			put: (self numSlotsMask << self numSlotsFullShift)
+ 				+ (1 << self pinnedBitShift)
+ 				+ (self wordIndexableFormat << self formatShift)
+ 				+ self segmentBridgePun!

Item was changed:
  ----- Method: SpurGenerationScavenger>>manager:newSpaceStart:newSpaceBytes:edenBytes: (in category 'initialization') -----
+ manager: aSpurMemoryManager newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes 	self manager: aSpurMemoryManager.
+ 	self newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes!
- manager: aSpurMemoryManager newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes 
- 	| edenBytes survivorBytes |
- 	manager := aSpurMemoryManager.
- 
- 	edenBytes := requestedEdenBytes.
- 	survivorBytes := totalBytes - edenBytes // 2 truncateTo: manager allocationUnit.
- 	edenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit.
- 	self assert: totalBytes - edenBytes - survivorBytes - survivorBytes < manager allocationUnit.
- 
- 	"for tenuring we require older objects below younger objects.  since allocation
- 	 grows up this means that the survivor spaces must preceed eden."
- 
- 	pastSpace start: startAddress limit: startAddress + survivorBytes.
- 	futureSpace start: pastSpace limit limit: pastSpace limit + survivorBytes.
- 	eden start: futureSpace limit limit: futureSpace limit + edenBytes.
- 
- 	self assert: futureSpace limit <= (startAddress + totalBytes).
- 	self assert: eden start \\ manager allocationUnit
- 				+ (eden limit \\ manager allocationUnit) = 0.
- 	self assert: pastSpace start \\ manager allocationUnit
- 				+ (pastSpace limit \\ manager allocationUnit) = 0.
- 	self assert: futureSpace start \\ manager allocationUnit
- 				+ (futureSpace limit \\ manager allocationUnit) = 0.
- 
- 	self initFutureSpaceStart.
- 	manager initSpaceForAllocationCheck: eden!

Item was added:
+ ----- Method: SpurGenerationScavenger>>newSpaceStart:newSpaceBytes:edenBytes: (in category 'initialization') -----
+ newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes 
+ 	| edenBytes survivorBytes |
+ 
+ 	edenBytes := requestedEdenBytes.
+ 	survivorBytes := totalBytes - edenBytes // 2 truncateTo: manager allocationUnit.
+ 	edenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit.
+ 	self assert: totalBytes - edenBytes - survivorBytes - survivorBytes < manager allocationUnit.
+ 
+ 	"for tenuring we require older objects below younger objects.  since allocation
+ 	 grows up this means that the survivor spaces must preceed eden."
+ 
+ 	pastSpace start: startAddress limit: startAddress + survivorBytes.
+ 	futureSpace start: pastSpace limit limit: pastSpace limit + survivorBytes.
+ 	eden start: futureSpace limit limit: futureSpace limit + edenBytes.
+ 
+ 	self assert: futureSpace limit <= (startAddress + totalBytes).
+ 	self assert: eden start \\ manager allocationUnit
+ 				+ (eden limit \\ manager allocationUnit) = 0.
+ 	self assert: pastSpace start \\ manager allocationUnit
+ 				+ (pastSpace limit \\ manager allocationUnit) = 0.
+ 	self assert: futureSpace start \\ manager allocationUnit
+ 				+ (futureSpace limit \\ manager allocationUnit) = 0.
+ 
+ 	self initFutureSpaceStart.
+ 	manager initSpaceForAllocationCheck: eden!

Item was changed:
  ----- Method: SpurMemoryManager>>adjustAllOopsBy: (in category 'initialization') -----
+ adjustAllOopsBy: bytesToShift
+ 	"Adjust all oop references by the given number of bytes. This is
+ 	 done just after reading in an image when the new base address
+ 	 of the object heap is different from the base address in the image,
+ 	 or when loading multiple segments that have been coallesced."
- adjustAllOopsBy: bytesToShift 
- 	"Adjust all oop references by the given number of bytes. This 
- 	is done just after reading in an image when the new base 
- 	address of the object heap is different from the base address 
- 	in the image."
  
  	| obj |
+ 	(bytesToShift ~= 0
+ 	 or: [segmentManager numSegments > 1]) ifTrue:
- 	<inline: false>
- 	bytesToShift ~= 0 ifTrue:
  		[self assert: self newSpaceIsEmpty.
+ 		 obj := self objectStartingAt: newSpaceLimit.
- 		 obj := self firstObject.
  		 [self oop: obj isLessThan: freeOldSpaceStart] whileTrue:
+ 			[(self isFreeObject: obj)
+ 				ifTrue: [self swizzleFieldsOfFreeChunk: obj]
+ 				ifFalse: [self swizzleFieldsOfObject: obj].
- 			[(self isFreeObject: obj) ifFalse:
- 				[self adjustFieldsAndClassOf: obj by: bytesToShift].
  			 obj := self objectAfter: obj]]!

Item was removed:
- ----- Method: SpurMemoryManager>>adjustFieldsAndClassOf:by: (in category 'initialization') -----
- adjustFieldsAndClassOf: oop by: offsetBytes 
- 	"Adjust all pointers in this object by the given offset."
- 	| fieldAddr fieldOop |
- 	<inline: true>
- 	<asmLabel: false>
- 	fieldAddr := oop + (self lastPointerOf: oop).
- 	[self oop: fieldAddr isGreaterThanOrEqualTo: oop + self baseHeaderSize] whileTrue:
- 		[fieldOop := self longAt: fieldAddr.
- 		 (self isNonImmediate: fieldOop) ifTrue:
- 			[self longAt: fieldAddr put: fieldOop + offsetBytes].
- 		 fieldAddr := fieldAddr - BytesPerOop]!

Item was changed:
  ----- Method: SpurMemoryManager>>edenBytes (in category 'accessing') -----
  edenBytes
+ 	<doNotGenerate>
+ 	^scavenger edenBytes!
- 	"during snapshot load newSpaceLimit holds newSpace size temporarily."
- 	scavenger eden limit ifNil:
- 		[| newSpaceBytes |
- 		 newSpaceBytes := newSpaceLimit - coInterpreter interpreterAllocationReserveBytes.
- 		 ^newSpaceBytes * self scavengerDenominator - self numSurvivorSpaces // self scavengerDenominator
- 			roundTo: self allocationUnit].
- 	"once initialized we can query the actual beast."
- 	^scavenger eden limit - scavenger eden start!

Item was added:
+ ----- Method: SpurMemoryManager>>firstSegmentSize: (in category 'snapshot') -----
+ firstSegmentSize: firstSegmentSize
+ 	<doNotGenerate>
+ 	"even an empty segment needs a bridge ;-)"
+ 	self assert: firstSegmentSize >= (2 * self baseHeaderSize).
+ 	segmentManager firstSegmentSize: firstSegmentSize!

Item was added:
+ ----- Method: SpurMemoryManager>>freeOldSpaceStart (in category 'snapshot') -----
+ freeOldSpaceStart
+ 	^freeOldSpaceStart!

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

Item was changed:
  ----- Method: SpurMemoryManager>>initSpaceForAllocationCheck: (in category 'allocation') -----
  initSpaceForAllocationCheck: aNewSpace
+ 	memory ifNotNil:
+ 		[CheckObjectOverwrite ifTrue:
+ 			[aNewSpace start
+ 				to: aNewSpace limit - 1
+ 				by: self wordSize
+ 				do: [:p| self longAt: p put: p]]]!
- 	CheckObjectOverwrite ifTrue:
- 		[aNewSpace start
- 			to: aNewSpace limit - 1
- 			by: self wordSize
- 			do: [:p| self longAt: p put: p]]!

Item was changed:
  ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
  initializeObjectMemory: bytesToShift
  	"Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks."
  	"Assume: image reader initializes the following variables:
  		memory
  		memoryLimit
  		specialObjectsOop
  		lastHash
  	"
  	<inline: false>
  	| freeListObj |
+ 	segmentManager parseSegmentsInNewlyLoadedImage: bytesToShift.
  	"image may be at a different address; adjust oops for new location"
  	self adjustAllOopsBy: bytesToShift.
  
+ 	segmentManager numSegments > 0 "false if Spur image bootstrap"
+ 		ifTrue: [specialObjectsOop := segmentManager swizzleObj: specialObjectsOop]
+ 		ifFalse: [self assert: bytesToShift = 0].
- 	specialObjectsOop := specialObjectsOop + bytesToShift.
  
  	"heavily used special objects"
  	nilObj		:= self splObj: NilObject.
  	falseObj	:= self splObj: FalseObject.
  	trueObj		:= self splObj: TrueObject.
  
  	"In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
  	 conditional branch code as a result).  In addition, Spur places the free lists and
  	 class table root page immediately following them."
  	self assert: nilObj = newSpaceLimit.
  	self assert: falseObj = (self objectAfter: nilObj).
  	self assert: trueObj = (self objectAfter: falseObj).
  	freeListObj := self objectAfter: trueObj.
  	self assert: (self numSlotsOf: freeListObj) = self numFreeLists.
  	self assert: (self formatOf: freeListObj) = (self wordSize = 4
  													ifTrue: [self firstLongFormat]
  													ifFalse: [self sixtyFourBitIndexableFormat]).
  	freeLists := self firstIndexableField: freeListObj.
+ 	0 to: self numFreeLists - 1 do:
+ 		[:i|
+ 		(freeLists at: i) ~= 0 ifTrue:
+ 			[freeLists at: i put: (segmentManager swizzleObj: (freeLists at: i))]].
  	self classTableRootObj: (self objectAfter: freeListObj).
+ .
+ 	segmentManager collapseSegmentsPostSwizzle.
- 
  	self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart"
  
  	"lowSpaceThreshold := 0.
  	signalLowSpace := false.
  	remapBufferCount := 0.
  	tenuringThreshold := 2000.  ""tenure all suriving objects if survivor count is over this threshold""
  	growHeadroom := 4*1024*1024. ""four megabytes of headroom when growing""
  	shrinkThreshold := 8*1024*1024. ""eight megabytes of free space before shrinking""
  
  	""garbage collection statistics""
  	statFullGCs := 0.
  	statFullGCUsecs := 0.
  	statIncrGCs := 0.
  	statIncrGCUsecs := 0.
  	statTenures := 0.
  	statRootTableOverflows := 0.
  	statGrowMemory := 0.
  	statShrinkMemory := 0.
  	forceTenureFlag := 0.
  	gcBiasToGrow := 0.
  	gcBiasToGrowGCLimit := 0.
  	extraRootCount := 0."!

Item was changed:
  ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') -----
  initializeOldSpaceFirstFree: startOfFreeOldSpace
  	<var: 'startOfFreeOldSpace' type: #usqLong>
  	| freeOldStart freeChunk |
  	<var: 'freeOldStart' type: #usqLong>
+ 	
- 
- 	self initSegmentBridgeWithBytes: 2 * self baseHeaderSize at: endOfMemory.
  	endOfMemory > startOfFreeOldSpace ifTrue:
  		[totalFreeOldSpace := totalFreeOldSpace + (endOfMemory - startOfFreeOldSpace).
  		 freeOldStart := startOfFreeOldSpace.
  		 [endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue:
  			[freeChunk := self freeChunkWithBytes: (2 raisedTo: 32) at: freeOldStart.
  			 freeOldStart := freeOldStart + (2 raisedTo: 32).
  			 self assert: freeOldStart = (self addressAfter: freeChunk)].
  		freeOldStart < endOfMemory ifTrue:
  			[freeChunk := self freeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart.
  			 self assert: (self addressAfter: freeChunk) = endOfMemory]].
  	freeOldSpaceStart := endOfMemory.
  	self checkFreeSpace!

Item was changed:
  ----- Method: SpurMemoryManager>>memory (in category 'accessing') -----
  memory
+ 	<cmacro: '() memory'>
  	^memory!

Item was added:
+ ----- Method: SpurMemoryManager>>memoryBaseForImageRead (in category 'snapshot') -----
+ memoryBaseForImageRead
+ 	"Answer the address to read the image into."
+ 	^newSpaceLimit!

Item was added:
+ ----- Method: SpurMemoryManager>>newSpaceBytes (in category 'accessing') -----
+ newSpaceBytes
+ 	"during snapshot load newSpaceLimit holds newSpace size temporarily."
+ 	^newSpaceLimit - coInterpreter interpreterAllocationReserveBytes!

Item was changed:
  ----- Method: SpurMemoryManager>>numSlotsOf: (in category 'object access') -----
  numSlotsOf: objOop
  	<returnTypeC: #usqInt>
+ 	| numSlots |
+ 	self flag: #endianness.
+ 	"numSlotsOf: should not be applied to free or forwarded objects."
+ 	self assert: (self classIndexOf: objOop) > self isForwardedObjectClassIndexPun.
+ 	numSlots := self rawNumSlotsOf: objOop..
+ 	^numSlots = self numSlotsMask	"overflow slots; (2^32)-1 slots are plenty"
+ 		ifTrue: [self rawOverflowSlotsOf: objOop]
+ 		ifFalse: [numSlots]!
- 	^self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>numSlotsOfAny: (in category 'object access') -----
  numSlotsOfAny: objOop
  	"A private internal version of numSlotsOf: that is happy to be applied to free or forwarded objects."
  	<returnTypeC: #usqInt>
  	| numSlots |
  	numSlots := self rawNumSlotsOf: objOop..
  	^numSlots = self numSlotsMask
+ 		ifTrue: [self rawOverflowSlotsOf: objOop] "overflow slots; (2^32)-1 slots are plenty"
- 		ifTrue: [self longAt: objOop - self baseHeaderSize] "overflow slots; (2^32)-1 slots are plenty"
  		ifFalse: [numSlots]!

Item was removed:
- ----- Method: SpurMemoryManager>>oopOfObjectStartingAt: (in category 'object enumeration') -----
- oopOfObjectStartingAt: address
- 	"Answer the oop of the memory chunk starting at address, which is either the address
- 	 of the overflow size word, or objOop itself, depending on the size of the object."
- 	self flag: #endianness.
- 	^(self longAt: address) >> self numSlotsHalfShift = self numSlotsMask
- 		ifTrue: [address + self baseHeaderSize]
- 		ifFalse: [address]!

Item was removed:
- ----- Method: SpurMemoryManager>>overflowSlotsMask (in category 'header format') -----
- overflowSlotsMask
- 	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>rawOverflowSlotsOf: (in category 'object access') -----
+ rawOverflowSlotsOf: objOop
+ 	<returnTypeC: #usqInt>
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>reInitSegmentBridge: (in category 'segments') -----
+ reInitSegmentBridge: bridgeOop
+ 	"On image write the segment manager replaces the header of the bridge
+ 	 with the size of the following segment.  This method restores that header."
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>setEndOfMemory: (in category 'snapshot') -----
+ setEndOfMemory: newEndOfMemory
+ 	"Set by the segment manager after swizzling the image."
+ 	endOfMemory := newEndOfMemory!

Item was added:
+ ----- Method: SpurMemoryManager>>setFreeOldSpaceStart: (in category 'snapshot') -----
+ setFreeOldSpaceStart: freeStart
+ 	"Set by the segment manager on parsing the image."
+ 	freeOldSpaceStart := freeStart!

Item was added:
+ ----- Method: SpurMemoryManager>>setHeapBase:memoryLimit:endOfMemory: (in category 'snapshot') -----
+ setHeapBase: heapBase memoryLimit: memLimit endOfMemory: memEnd
+ 	Transcript
+ 		cr; nextPutAll: 'heapBase: '; print: heapBase; nextPut: $/; nextPutAll: heapBase hex;
+ 		nextPutAll: ' memLimit '; print: memLimit; nextPut: $/; nextPutAll: memLimit hex;
+ 		nextPutAll: ' memEnd '; print: memEnd; nextPut: $/; nextPutAll: memEnd hex; cr; flush.
+ 	newSpaceLimit := heapBase
+ 					 + self newSpaceBytes
+ 					 + coInterpreter interpreterAllocationReserveBytes.
+ 	freeOldSpaceStart := memEnd.
+ 	endOfMemory := memLimit.
+ 	scavenger
+ 		newSpaceStart: heapBase
+ 		newSpaceBytes: newSpaceLimit - heapBase
+ 		edenBytes: newSpaceLimit - heapBase
+ 				   * (self scavengerDenominator - self numSurvivorSpaces) // self scavengerDenominator.
+ 	freeStart := scavenger eden start.
+ 	pastSpaceStart := scavenger pastSpace start!

Item was changed:
  ----- Method: SpurMemoryManager>>startOfMemory (in category 'accessing') -----
  startOfMemory
  	"Return the start of object memory.  This is immediately after the native code zone.
  	 N.B. the stack zone is alloca'ed. Use a macro so as not to punish the debug VM."
  	<cmacro: '() heapBase'> "This is for CoInterpreter, not StackInterpreter"
  	<returnTypeC: #usqInt>
  	self flag: #fixme.
+ 	^startOfMemory ifNil: [0]!
- 	^startOfMemory!

Item was added:
+ ----- Method: SpurMemoryManager>>swizzleFieldsOfFreeChunk: (in category 'initialization') -----
+ swizzleFieldsOfFreeChunk: chunk
+ 	<inline: true>
+ 	0 to: ((self bytesInObject: chunk) / self allocationUnit > self numFreeLists
+ 			ifTrue: [self freeChunkLargerIndex]
+ 			ifFalse: [self freeChunkNextIndex])
+ 	   do: [:index| | field |
+ 		field := self fetchPointer: index ofFreeChunk: chunk.
+ 		field ~= 0 ifTrue:
+ 			[self storePointer: index
+ 				ofFreeChunk: chunk
+ 				withValue: (segmentManager swizzleObj: field)]]!

Item was added:
+ ----- Method: SpurMemoryManager>>swizzleFieldsOfObject: (in category 'initialization') -----
+ swizzleFieldsOfObject: oop
+ 	| fieldAddr fieldOop |
+ 	<inline: true>
+ 	fieldAddr := oop + (self lastPointerOf: oop).
+ 	[self oop: fieldAddr isGreaterThanOrEqualTo: oop + self baseHeaderSize] whileTrue:
+ 		[fieldOop := self longAt: fieldAddr.
+ 		 (self isNonImmediate: fieldOop) ifTrue:
+ 			[self longAt: fieldAddr put: (segmentManager swizzleObj: fieldOop)].
+ 		 fieldAddr := fieldAddr - BytesPerOop]!

Item was changed:
  ----- Method: SpurSegmentInfo>>printOn: (in category 'printing') -----
  printOn: aStream
  	super printOn: aStream.
  	self class instVarNames do:
+ 		[:name| | iv |
+ 		iv := self instVarNamed: name.
+ 		aStream space; nextPutAll: name; space; print: iv.
+ 		iv isInteger ifTrue:
+ 			[aStream nextPut: $/.  iv storeOn: aStream base: 16]]!
- 		[:name|
- 		aStream space; nextPutAll: name; space; print: (self instVarNamed: name)]!

Item was changed:
  CogClass subclass: #SpurSegmentManager
+ 	instanceVariableNames: 'manager numSegments segments firstSegmentSize numSegmentsAllocated'
- 	instanceVariableNames: 'manager numSegments segments'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-SpurMemoryManager'!
  
  !SpurSegmentManager commentStamp: 'eem 10/6/2013 10:32' prior: 0!
  Instances of SpurSegmentManager manage oldSpace, which is organized as a sequence of segments.  Segments can be obtained from the operating system and returned to the operating system when empty and shrinkage is required.  Segments are kept invisible from the SpurMemoryManager by using "bridge" objects, "fake" pinned objects to bridge the gaps between segments.  A pinned object header occupies the last 16 bytes of each segment, and the pinned object's size is the distance to the start of the next segment.  So when the memory manager enumerates objects it skips over these bridges and memory appears linear.  The constraint is that segments obtained from the operating system must be at a higher address than the first segment.  The maximum size of large objects, being an overflow slot size, should be big enough to bridge the gaps, because in 32-bits the maximum size is 2^32 slots.  In 64-bits the maximum size of large objects is 2^56 slots, or 2^59 bits, which we hope will suffice.
  
  When an image is written to a snapshot file the second word of the header of the bridge at the end of each segment is replaced by the size of the following segment, the segments are written to the file, and the second word of each bridge is restored.  Hence the length of each segment is derived from the bridge at the end of the preceeding segment.  The length of the first segment is stored in the image header as firstSegmentBytes.  The start of each segment is also derived from the bridge as a delta from the start of the previous segment.  The start of The first segment is stored in the image header as startOfMemory.
  
  On load all segments are read into one single segment, eliminating the bridge objects, and computing the swizzle distance for each segment, based on where the segments were in memory when the image file was written, and where the coallesced segment ends up on load.  Then the segment is traversed, swizzling pointers by selecting the relevant swizzle for each oop's segment.
  
  Instance Variables
  	numSegments:		<Integer>
  	segments:			<Array of SpurSegmentInfo>
  	manager:			<SpurMemoryManager>
  
  numSegments
  	- the number of segments
  
  segments
  	- the start addresses, lengths and offsets to adjust oops on image load, for each segment
  
  manager
  	- the SpurMemoryManager whose oldSpace is managed (simulation only).!

Item was added:
+ ----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') -----
+ collapseSegmentsPostSwizzle
+ 	"The image has been loaded, old segments reconstructed, and the
+ 	  loaded image swizzled into a single contiguous segment.  Collapse
+ 	 the segments, and free the old bridges."
+ 	| bridge |
+ 	firstSegmentSize ifNil: "true when used by SpurBootstrap to transform an image"
+ 		[^self].
+ 
+ 	numSegmentsAllocated := numSegments.
+ 	numSegments := 0.
+ 	"segment sizes include the two-header-word bridge at the end of each segment."
+ 	bridge := firstSegmentSize + manager newSpaceLimit - manager baseHeaderSize.
+ 	1 to: numSegmentsAllocated - 1 do:
+ 		[:i|
+ 		 manager
+ 			freeChunkWithBytes: 2 * manager baseHeaderSize
+ 			at: bridge - manager baseHeaderSize.
+ 		 bridge := bridge + (segments at: i) segSize].
+ 	"now bridge is pointing to last bridge in loaded image.  free the bridge, add a
+ 	 bridge at the end of memory, and cut back end of memory to before the bridge."
+ 	manager
+ 		freeChunkWithBytes: 2 * manager baseHeaderSize
+ 		at: bridge - manager baseHeaderSize.
+ 	"now update the segment to reflect the coallesced segments"
+ 	numSegments := 1.
+ 	(segments at: 0)
+ 		start: manager newSpaceLimit;
+ 		segSize: manager endOfMemory.
+ 	"finally plant a bridge at the end of the coallesced segment and cut back the
+ 	 manager's ntion of the end of memory to immediately before the bridge."
+ 	bridge := manager endOfMemory - (2 * manager baseHeaderSize).
+ 	manager
+ 		initSegmentBridgeWithBytes: 2 * manager baseHeaderSize at: bridge;
+ 		setEndOfMemory: bridge!

Item was added:
+ ----- Method: SpurSegmentManager>>firstSegmentSize: (in category 'initialization') -----
+ firstSegmentSize: firstSegSize
+ 	"Remember firstSegSize for subsequent image segment parsing."
+ 	firstSegmentSize := firstSegSize!

Item was changed:
  ----- Method: SpurSegmentManager>>initializeFromFreeChunks: (in category 'simulation only') -----
  initializeFromFreeChunks: freeChunks
  	"For testing, create a set of segments using the freeChunks as bridges."
  	numSegments := freeChunks size.
  	freeChunks do:
  		[:f|
  		manager initSegmentBridgeWithBytes: (manager bytesInObject: f) at: (manager startOfObject: f).
  		self assert: (manager isSegmentBridge: f)].
  	segments := (1 to: numSegments) collect:
+ 					[:i| | bridge start size |
+ 					bridge := freeChunks at: i.
- 					[:i| | start |
  					start := i = 1
  								ifTrue: [manager newSpaceLimit]
  								ifFalse: [manager addressAfter: (freeChunks at: i - 1)].
+ 					size := bridge + manager baseHeaderSize - start.
  					SpurSegmentInfo new
  						start: start;
+ 						segSize: size;
- 						segSize: (freeChunks at: i) + manager baseHeaderSize - start;
  						yourself].
  	segments := CArrayAccessor on: segments.
  	freeChunks do:
  		[:bridge| self assert: (manager isValidSegmentBridge: bridge)]!

Item was added:
+ ----- Method: SpurSegmentManager>>numSegments (in category 'accessing') -----
+ numSegments
+ 	^numSegments!

Item was added:
+ ----- Method: SpurSegmentManager>>parseSegmentsInNewlyLoadedImage: (in category 'snapshot') -----
+ parseSegmentsInNewlyLoadedImage: firstSegmentShift
+ 	"Skip through the bridge objects, counting the number of segments.
+ 	 Then allocate the segment info and scan again, computing the swizzle
+ 	 ammounts for each segment."
+ 	| bridge nextSegmentSize oldBase newBase segInfo bridgeSpan |
+ 	<var: 'segInfo' type: 'SpurSegmentInfo *'>
+ 	firstSegmentSize ifNil: "true when used by SpurBootstrap to transform an image"
+ 		[^self].
+ 
+ 	numSegments := 0.
+ 	"segment sizes include the two-header-word bridge at the end of each segment."
+ 	bridge := firstSegmentSize + manager newSpaceLimit - manager baseHeaderSize.
+ 	[numSegments := numSegments + 1.
+ 	 nextSegmentSize := manager longLongAt: bridge.
+ 	 nextSegmentSize ~= 0] whileTrue:
+ 		[bridge := bridge + nextSegmentSize].
+ 	segments := self
+ 					cCode: [self c: numSegments alloc: (self sizeof: SpurSegmentInfo)]
+ 					inSmalltalk: [CArrayAccessor on: ((1 to: numSegments) collect: [:i| SpurSegmentInfo new])].
+ 
+ 	numSegments := 0.
+ 	oldBase := manager newSpaceLimit - firstSegmentShift.
+ 	newBase := manager newSpaceLimit.
+ 	nextSegmentSize := firstSegmentSize.
+ 	bridge := firstSegmentSize + manager newSpaceLimit - manager baseHeaderSize.
+ 	[segInfo := self addressOf: (segments at: numSegments).
+ 	 segInfo
+ 		start: oldBase;
+ 		segSize: nextSegmentSize;
+ 		swizzle: newBase - oldBase.
+ 	 numSegments := numSegments + 1.
+ 	 bridgeSpan := manager bytesPerSlot * (manager rawOverflowSlotsOf: bridge).
+ 	 oldBase := oldBase + nextSegmentSize + bridgeSpan.
+ 	 newBase := newBase + nextSegmentSize.
+ 	 nextSegmentSize := manager longLongAt: bridge.
+ 	 nextSegmentSize ~= 0] whileTrue:
+ 		[bridge := bridge + nextSegmentSize].
+ 	"newBase should point just past the last bridge."
+ 	self assert: (manager longLongAt: newBase - manager baseHeaderSize) = 0.
+ 	"set freeOldSpaceStart now for adjustAllOopsBy:"
+ 	manager setFreeOldSpaceStart: newBase!

Item was added:
+ ----- Method: SpurSegmentManager>>swizzleObj: (in category 'snapshot') -----
+ swizzleObj: objOop
+ 	1 to: numSegments - 1 do:
+ 		[:i|
+ 		objOop < (segments at: i) start ifTrue:
+ 			[^objOop + (segments at: i - 1) swizzle]].
+ 	^objOop + (segments at: numSegments - 1) swizzle!

Item was changed:
  ----- Method: SpurSegmentManager>>writeImageToFile: (in category 'snapshot') -----
  writeImageToFile: aBinaryStream
  	| total |
  	total := 0.
+ 	firstSegmentSize ifNotNil:
+ 		[self assert: firstSegmentSize = (segments at: 0) segSize].
  	0 to: numSegments - 1 do:
+ 		[:i| | nextSegSize |
+ 		nextSegSize := i = (numSegments - 1)
+ 							ifTrue: [0]
+ 							ifFalse: [(segments at: i + 1) segSize].
+ 		total := total + (self writeSegment: (segments at: i)
+ 							nextSegmentSize: nextSegSize
+ 							toFile: aBinaryStream)].
- 		[:i|
- 		total := total + (self writeSegment: (segments at: i) toFile: aBinaryStream)].
  	^total!

Item was added:
+ ----- Method: SpurSegmentManager>>writeSegment:nextSegmentSize:toFile: (in category 'snapshot') -----
+ writeSegment: aSpurSegmentInfo nextSegmentSize: nextSegSize toFile: aBinaryStream
+ 	<var: 'aSpurSegmentInfo' type: 'SpurSegmentInfo *'>
+ 	<var: 'aBinaryStream' type: #'FILE *'>
+ 	| bridge savedHeader nWritten |
+ 	<var: 'savedHeader' type: #usqLong>
+ 	bridge := aSpurSegmentInfo start + aSpurSegmentInfo segSize - manager baseHeaderSize.
+ 	self assert: (manager isValidSegmentBridge: bridge).
+ 	savedHeader := manager longLongAt: bridge.
+ 	manager longLongAt: bridge put: nextSegSize.
+ 	nWritten := self cCode:
+ 						[self
+ 							sq: aSpurSegmentInfo start
+ 							Image: 1
+ 							File: aSpurSegmentInfo segSize
+ 							Write: aBinaryStream]
+ 					inSmalltalk:
+ 						[aBinaryStream
+ 							next: aSpurSegmentInfo segSize / 4
+ 							putAll: manager memory
+ 							startingAt: aSpurSegmentInfo start / 4 + 1.
+ 						 aSpurSegmentInfo segSize].
+ 	manager longLongAt: bridge put: savedHeader.
+ 	^nWritten!

Item was removed:
- ----- Method: SpurSegmentManager>>writeSegment:toFile: (in category 'snapshot') -----
- writeSegment: aSpurSegmentInfo toFile: aBinaryStream
- 	<var: 'aSpurSegmentInfo' type: 'SpurSegmentInfo *'>
- 	<var: 'aBinaryStream' type: #'FILE *'>
- 	^self cCode:
- 			[self
- 				sq: aSpurSegmentInfo start
- 				Image: 1
- 				File: aSpurSegmentInfo segSize
- 				Write: aBinaryStream]
- 		inSmalltalk:
- 			[aBinaryStream
- 				next: aSpurSegmentInfo segSize / 4
- 				putAll: manager memory
- 				startingAt: aSpurSegmentInfo start / 4 + 1.
- 			 aSpurSegmentInfo segSize]!

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
+ 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassSizeBits interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals gcSemaphoreIndex classByteArrayCompactIndex'
- 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassSizeBits interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals gcSemaphoreIndex classByteArrayCompactIndex'
  	classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex PrimitiveExternalCallIndex PrimitiveTable'
  	poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets'
  	category: 'VMMaker-Interpreter'!
  
  !StackInterpreter commentStamp: 'eem 9/11/2013 18:30' prior: 0!
  This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas.  This VM supports Closures but *not* old-style BlockContexts.
  
  It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
  
  The VM does not use Contexts directly.  Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image.  There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up.  The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations.  A send establishes a new frame in the current stack page, a return returns to the previous frame.  This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return.  Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together).  Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse frame has been returned from (died).  A married context is specially marked (more details in the code) and refers to its frame.  Likewise a married frame is specially marked and refers to its context.
  
  In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
  
  NOTE:  Here follows a list of things to be borne in mind when working on this code, or when making changes for the future.
  
  1.  There are a number of things that should be done the next time we plan to release a completely incompatible image format.  These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:.  Also, contexts should be given a special format code (see next item).
  
  2.  There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change.  This is necessary because the oops may change during a compaction when the oops are being adjusted.  It's important to be aware of this when writing a new image using the SystemTracer.  A better solution would be to reserve one of the format codes for Contexts only.  An even better solution is to eliminate compact classes altogether (see 6.).
  
  3.  We have made normal files tolerant to size and positions up to 32 bits.  This has not been done for async files, since they are still experimental.  The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes. [Late news, the support has been extended to 64-bit file sizes].
  
  4.  Note that 0 is used in a couple of places as an impossible oop.  This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment).  The places include the method cache and the at cache.
  
  5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT.  We can still have 31-bit SmallIntegers by allowing two tag patterns for SmallInteger.
  
  6.  If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images.  [Late breaking news, the 2-word header scheme is more compact, by over 2%].  See SpurMemorymanager's class comment.!

Item was changed:
  ----- Method: StackInterpreter>>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 hdrNumStackPages
  	  minimumMemory heapBase bytesRead bytesToShift heapSize hdrEdenBytes
+ 	  headerFlags hdrMaxExtSemTabSize firstSegSize |
- 	  headerFlags hdrMaxExtSemTabSize |
  	<var: #f type: 'sqImageFile '>
  	<var: #heapBase type: 'usqInt'>
  	<var: #desiredHeapSize type: 'usqInt'>
  	<var: #headerStart type: 'squeakFileOffsetType '>
  	<var: #dataSize type: 'size_t '>
  	<var: #imageOffset type: 'squeakFileOffsetType '>
  
  	metaclassSizeBits := 6 * BytesPerWord.	"guess (Metaclass instSize * BPW)"
  	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.
- 	headerFlags			:= self getLongFromFile: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
+ 	extraVMMemory	:= self getLongFromFile: f swap: swapBytes.
- 	extraVMMemory		:= self getLongFromFile: f swap: swapBytes.
  	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.
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
+ 	 It is used for the cog code size in Cog.  Preserve it to be polite to other VMs."
- 	 Preserve it to be polite to images run on Cog."
  	theUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	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 nextLongFrom: f swap: swapBytes.
+ 	objectMemory firstSegmentSize: firstSegSize.
  	"decrease Squeak object heap to leave extra memory for the VM"
  	heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
  
  	"compare memory requirements with availability".
+ 	minimumMemory := dataSize + objectMemory newSpaceBytes + self interpreterAllocationReserveBytes.
- 	minimumMemory := dataSize + objectMemory edenBytes + self interpreterAllocationReserveBytes.
  	heapSize < minimumMemory ifTrue:
  		[self insufficientMemorySpecifiedError].
  
  	"allocate a contiguous block of memory for the Squeak heap"
  	objectMemory memory: (self
  								allocateMemory: heapSize
  								minimum: minimumMemory
  								imageFile: f
  								headerSize: headerSize) asUnsignedInteger.
  	objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
  
  	heapBase := objectMemory startOfMemory.
  	objectMemory
  		setHeapBase: heapBase
  		memoryLimit: (heapBase + heapSize) - 24  "decrease memoryLimit a tad for safety"
  		endOfMemory: heapBase + 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 := self 
+ 					sq: (self pointerForOop: objectMemory memoryBaseForImageRead)
+ 					Image: (self sizeof: #char)
+ 					File: dataSize
+ 					Read: f.
- 	bytesRead := self cCode: 'sqImageFileRead(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	"compute difference between old and new memory base addresses"
+ 	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
- 	bytesToShift := heapBase - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	^dataSize!

Item was changed:
  ----- Method: StackInterpreter>>writeImageFileIO (in category 'image save/restore') -----
  writeImageFileIO
  
  	| headerStart headerSize f bytesWritten sCWIfn okToWrite |
  	<var: #f type: 'sqImageFile'>
  	<var: #headerStart type: 'squeakFileOffsetType '>
  	<var: #sCWIfn type: 'void *'>
  
  	"If the security plugin can be loaded, use it to check for write permission.
  	If not, assume it's ok"
  	sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'.
  	sCWIfn ~= 0 ifTrue:
  		[okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'.
  		 okToWrite ifFalse:[^self primitiveFail]].
  	
  	"local constants"
  	headerStart := 0.  
  	headerSize := 64.  "header size in bytes; do not change!!"
  
  	f := self cCode: 'sqImageFileOpen(imageName, "wb")'.
  	f = nil ifTrue: "could not open the image file for writing"
  		[^self primitiveFail].
  
  	headerStart := self cCode: 'sqImageFileStartLocation(f,imageName,headerSize+imageBytes)'.
  	self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'.
  	"position file to start of header"
  	self sqImageFile: f Seek: headerStart.
  
  	self putLong: self imageFormatVersion toFile: f.
  	self putLong: headerSize toFile: f.
  	self putLong: objectMemory imageSizeToWrite toFile: f.
  	self putLong: objectMemory baseAddressOfImage toFile: f.
  	self putLong: objectMemory specialObjectsOop toFile: f.
  	self putLong: objectMemory newObjectHash toFile: f.
  	self putLong: self ioScreenSize toFile: f.
  	self putLong: self getImageHeaderFlags toFile: f.
  	self putLong: extraVMMemory toFile: f.
  	self putShort: desiredNumStackPages toFile: f.
  	self putShort: self unknownShortOrCodeSizeInKs toFile: f.
  	self putLong: desiredEdenBytes toFile: f.
  	self putShort: (maxExtSemTabSizeSet ifTrue: [self ioGetMaxExtSemTableSize] ifFalse: [0]) toFile: f.
+ 	self putShort: the2ndUnknownShort toFile: f.
- 	self putShort: 0 toFile: f.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[self putLong: objectMemory firstSegmentBytes toFile: f."Pad the rest of the header."
  			 1 to: 3 do: [:i| self putLong: 0 toFile: f]]
  		ifFalse:
  			[1 to: 4 do: [:i| self putLong: 0 toFile: f]].  "fill remaining header words with zeros"
  	self successful ifFalse: [
  		"file write or seek failure"
  		self cCode: 'sqImageFileClose(f)'.
  		^ nil].
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"write the image data"
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[bytesWritten := objectMemory segmentManager writeImageToFile: f]
  		ifFalse:
  			[| memStart |
  			memStart := objectMemory baseAddressOfImage.
  			bytesWritten := self sq: (self pointerForOop: memStart)
  								Image: (self sizeof: #char)
  								File: objectMemory imageSizeToWrite
  								Write: f.
  	self touch: memStart].
  	self success: bytesWritten = objectMemory imageSizeToWrite.
  	self cCode: 'sqImageFileClose(f)'
  !

Item was added:
+ ----- Method: StackInterpreterSimulator>>getLongFromFile:swap: (in category 'initialization') -----
+ getLongFromFile: aStream swap: swapFlag
+ 	^swapFlag 
+ 		ifTrue: [objectMemory byteSwapped: (self nextLongFrom: aStream)]
+ 		ifFalse: [self nextLongFrom: aStream]!

Item was added:
+ ----- Method: StackInterpreterSimulator>>getShortFromFile:swap: (in category 'image save/restore') -----
+ getShortFromFile: aFile swap: swapFlag
+ 	| aShort |
+ 	aShort := self nextShortFrom: aFile.
+ 	^swapFlag 
+ 		ifTrue: [(aShort bitShift: -8) + ((aShort bitAnd: 16rFF) bitShift: 8)]
+ 		ifFalse: [aShort]!

Item was removed:
- ----- Method: StackInterpreterSimulator>>nextLongFrom:swap: (in category 'initialization') -----
- nextLongFrom: aStream swap: swapFlag
- 	swapFlag 
- 		ifTrue: [^ objectMemory byteSwapped: (self nextLongFrom: aStream)]
- 		ifFalse: [^ self nextLongFrom: aStream]!

Item was removed:
- ----- Method: StackInterpreterSimulator>>nextShortFrom:swap: (in category 'initialization') -----
- nextShortFrom: aStream swap: swapFlag
- 	| aShort |
- 	aShort := self nextShortFrom: aStream.
- 	^swapFlag 
- 		ifTrue: [(aShort bitShift: -8) + ((aShort bitAnd: 16rFF) bitShift: 8)]
- 		ifFalse: [aShort]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>openOn:extraMemory: (in category 'initialization') -----
  openOn: fileName extraMemory: extraBytes
  	"StackInterpreterSimulator new openOn: 'clone.im' extraMemory: 100000"
  
  	| f version headerSize dataSize count oldBaseAddr bytesToShift swapBytes
+ 	  hdrNumStackPages hdrEdenBytes headerFlags heapBase firstSegSize hdrMaxExtSemTabSize |
- 	  hdrNumStackPages hdrEdenBytes headerFlags heapBase |
  	"open image file and read the header"
  
  	["begin ensure block..."
  	f := FileStream readOnlyFileNamed: fileName.
  	imageName := f fullName.
  	f binary.
  	version := self nextLongFrom: f.  "current version: 16r1968 (=6504) vive la revolucion!!"
  	(self readableFormat: version)
  		ifTrue: [swapBytes := false]
  		ifFalse: [(version := objectMemory byteSwapped: version) = self imageFormatVersion
  					ifTrue: [swapBytes := true]
  					ifFalse: [self error: 'incomaptible image format']].
+ 	headerSize := self getLongFromFile: f swap: swapBytes.
+ 	dataSize := self getLongFromFile: f swap: swapBytes.  "length of heap in file"
+ 	oldBaseAddr := self getLongFromFile: f swap: swapBytes.  "object memory base address of image"
+ 	objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
+ 	objectMemory lastHash: (self getLongFromFile: f swap: swapBytes).  "Should be loaded from, and saved to the image header"
- 	headerSize := self nextLongFrom: f swap: swapBytes.
- 	dataSize := self nextLongFrom: f swap: swapBytes.  "length of heap in file"
- 	oldBaseAddr := self nextLongFrom: f swap: swapBytes.  "object memory base address of image"
- 	objectMemory specialObjectsOop: (self nextLongFrom: f swap: swapBytes).
- 	objectMemory lastHash: (self nextLongFrom: f swap: swapBytes).  "Should be loaded from, and saved to the image header"
  
+ 	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
+ 	headerFlags		:= self getLongFromFile: f swap: swapBytes.
- 	savedWindowSize	:= self nextLongFrom: f swap: swapBytes.
- 	headerFlags			:= self nextLongFrom: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
+ 	extraVMMemory	:= self getLongFromFile: f swap: swapBytes.
+ 	hdrNumStackPages	:= self getShortFromFile: f swap: swapBytes.
- 	extraVMMemory		:= self nextLongFrom: f swap: swapBytes.
- 	hdrNumStackPages	:= self nextShortFrom: 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"
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
+ 	 It is used for the cog code size in Cog.  Preserve it to be polite to other VMs."
- 	 Preserve it to be polite to images run on Cog."
  	theUnknownShort	:= self getShortFromFile: f swap: swapBytes.
+ 	self assert: f position = 40.
+ 	hdrEdenBytes		:= self getLongFromFile: f swap: swapBytes.
- 	hdrEdenBytes		:= self nextLongFrom: f swap: swapBytes.
  	objectMemory edenBytes: (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.
+ 	self assert: f position = 48.
+ 	firstSegSize := self getLongFromFile: f swap: swapBytes.
+ 	objectMemory firstSegmentSize: firstSegSize.
  	"allocate interpreter memory"
  	heapBase := objectMemory startOfMemory.
  	objectMemory
  		setHeapBase: heapBase
+ 		memoryLimit: heapBase + dataSize + extraBytes + objectMemory newSpaceBytes + self interpreterAllocationReserveBytes
- 		memoryLimit: heapBase + dataSize + extraBytes + objectMemory edenBytes + self interpreterAllocationReserveBytes
  		endOfMemory: heapBase + dataSize.
  	objectMemory memory: (Bitmap new: objectMemory memoryLimit // 4).
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	f position: headerSize.
+ 	count := f	readInto: objectMemory memory
+ 				startingAt: objectMemory memoryBaseForImageRead // 4 + 1
+ 				count: dataSize // 4.
+ 	count ~= (dataSize // 4) ifTrue: [self halt].
- 	count := f readInto: objectMemory memory startingAt: 1 count: dataSize // 4.
- 	count ~= (objectMemory endOfMemory // 4) ifTrue: [self halt].
  	]
  		ensure: [f close].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
+ 	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.  "adjust pointers for zero base address"
- 	bytesToShift := objectMemory startOfMemory - oldBaseAddr.  "adjust pointers for zero base address"
  	Utilities informUser: 'Relocating object pointers...'
  				during: [self initializeInterpreter: bytesToShift].
  !



More information about the Vm-dev mailing list