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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.341
Author: eem
Time: 2 September 2013, 1:24:55.349 pm
UUID: 0185fd6f-6cba-49fd-9f4f-5a9c4965f53e
Ancestors: VMMaker.oscog-eem.340

Add more initialization post-bootstrap, including separate free
space in old space.

Add CogMemoryManager>>lastPointerOf: et al.

Move assignment of stackPages into computeStackZoneSize and
simplify clients.

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

Item was removed:
- ----- Method: CoInterpreter>>computeStackZoneSize (in category 'initialization') -----
- computeStackZoneSize
- 	^numStackPages * ((self sizeof: InterpreterStackPage) + self stackPageByteSize)
- 	 + stackPages extraStackBytes!

Item was changed:
  ----- Method: CoInterpreter>>initStackPagesAndInterpret (in category 'initialization') -----
  initStackPagesAndInterpret
  	"Initialize the stack pages and enter interpret. Use alloca'ed memory so that when
  	 we have a JIT its stack pointer will be on the native stack since alloca allocates
  	 memory on the stack. Certain thread systems use the native stack pointer as the
  	 frame ID so putting the stack anywhere else can confuse the thread system."
  
  	"Override to establish the setjmp/longjmp handler for reentering the interpreter
  	 from machine code, and disable executablity on the heap and stack pages."
  
  	"This should be in its own initStackPages method but Slang can't inline
  	 C code strings."
  	| stackPageBytes stackPagesBytes theStackMemory |
  	<var: #theStackMemory type: #'char *'>
  	stackPageBytes := self stackPageByteSize.
  	stackPagesBytes := self computeStackZoneSize.
  	theStackMemory := self
+ 							cCode: [self alloca: stackPagesBytes]
+ 							inSmalltalk: [stackPages initializeWithByteSize: stackPagesBytes for: self].
- 						cCode: [self alloca: stackPagesBytes]
- 						inSmalltalk:
- 							[stackPages := self stackPagesClass new.
- 							 stackPages initializeWithByteSize: stackPagesBytes for: self].
  	self cCode: [self me: theStackMemory ms: 0 et: stackPagesBytes].
  	self sqMakeMemoryNotExecutableFrom: objectMemory startOfMemory asUnsignedInteger
  		To: objectMemory memoryLimit asUnsignedInteger.
  	self sqMakeMemoryNotExecutableFrom: theStackMemory asUnsignedInteger
  		To: theStackMemory asUnsignedInteger + stackPagesBytes.
  	stackPages
  		initializeStack: theStackMemory
  		numSlots: stackPagesBytes / BytesPerWord
  		pageSize: stackPageBytes / BytesPerWord.
  	self assert: self minimumUnusedHeadroom = stackPageBytes.
  
  	"Once the stack pages are initialized we can continue to bootstrap the system."
  	self loadInitialContext.
  	"We're ready for the heartbeat (poll interrupt)"
  	self ioInitHeartbeat.
  	self initialEnterSmalltalkExecutive.
  	^nil!

Item was changed:
  CogClass subclass: #CogMemoryManager
(excessive size, no diff calculated)

Item was added:
+ ----- Method: CogMemoryManager class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"CogObjectMemory initialize"
+ 	NumFreeLists := 65 "One for each size up to and including 64 slots. One for sizes > 64 slots."!

Item was added:
+ ----- Method: CogMemoryManager>>addressAfter: (in category 'object enumeration') -----
+ addressAfter: objOop
+ 	"Answer the address immediately following an object."
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: CogMemoryManager>>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."
+ 	"di 11/18/2000 - return number of objects found"
+ 
+ 	| obj |
+ 	<inline: false>
+ 	bytesToShift ~= 0 ifTrue:
+ 		[obj := self firstObject.
+ 		 [self oop: obj isLessThan: freeStart] whileTrue:
+ 			[(self isFreeObject: obj) ifFalse:
+ 				[self adjustFieldsAndClassOf: obj by: bytesToShift].
+ 			 obj := self objectAfter: obj]]!

Item was added:
+ ----- Method: CogMemoryManager>>adjustFieldsAndClassOf:by: (in category 'initialization') -----
+ adjustFieldsAndClassOf: oop by: offsetBytes 
+ 	"Adjust all pointers in this object by the given offset."
+ 	self subclassResponsibility!

Item was changed:
  ----- Method: CogMemoryManager>>allocateMemoryOfSize:newSpaceSize:codeSize: (in category 'simulation') -----
  allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes codeSize: codeBytes
  	<doNotGenerate>
  	self assert: (memoryBytes \\ self allocationUnit = 0
  				and: [newSpaceBytes \\ self allocationUnit = 0
  				and: [codeBytes \\ self allocationUnit = 0]]).
  	memory := (self endianness == #little
  					ifTrue: [LittleEndianBitmap]
  					ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes) // 4.
  	startOfMemory := codeBytes.
+ 	endOfMemory := memoryBytes + newSpaceBytes + codeBytes.
  	"leave newSpace empty for the bootstrap"
  	freeStart := newSpaceBytes + startOfMemory.
+ 	newSpaceStart := startOfMemory.
  	newSpaceLimit := newSpaceBytes + startOfMemory.
  	scavengeThreshold := memory size * 4 "Bitmap is a 4-byte per word array"!

Item was added:
+ ----- Method: CogMemoryManager>>baseHeader: (in category 'header access') -----
+ baseHeader: obj
+ 	^self longLongAt: obj!

Item was added:
+ ----- Method: CogMemoryManager>>baseSlotSizeOf: (in category 'object access') -----
+ baseSlotSizeOf: oop
+ 	<returnTypeC: #usqInt>
+ 	| halfHeader slotSize |
+ 	self flag: #endianness.
+ 	halfHeader := self longAt: oop + 4.
+ 	slotSize := halfHeader >> self slotSizeHalfShift bitAnd: self slotSizeMask.
+ 	^slotSize = self slotSizeMask
+ 		ifTrue: [self longAt: oop - self baseHeaderSize] "overflow slots; (2^32)-1 slots are plenty"
+ 		ifFalse: [slotSize]!

Item was added:
+ ----- Method: CogMemoryManager>>coInterpreter: (in category 'simulation') -----
+ coInterpreter: aCoInterpreter
+ 	<doNotGenerate>
+ 	coInterpreter := aCoInterpreter!

Item was added:
+ ----- Method: CogMemoryManager>>firstCompiledMethodFormat (in category 'header format') -----
+ firstCompiledMethodFormat
+ 	^24!

Item was added:
+ ----- Method: CogMemoryManager>>formatOfHeader: (in category 'object access') -----
+ formatOfHeader: header
+ 	<var: 'header' type: #usqLong>
+ 	"0 = 0 sized objects (UndefinedObject True False et al)
+ 	 1 = non-indexable objects with inst vars (Point et al)
+ 	 2 = indexable objects with no inst vars (Array et al)
+ 	 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 	 4 = weak indexable objects with inst vars (WeakArray et al)
+ 	 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 	 6,7,8 unused
+ 	 9 (?) 64-bit indexable
+ 	 10 - 11 32-bit indexable
+ 	 12 - 15 16-bit indexable
+ 	 16 - 23 byte indexable
+ 	 24 - 31 compiled method"
+ 	^header >> self formatShift bitAnd: self formatMask!

Item was changed:
  ----- Method: CogMemoryManager>>headerForSlots:format:classIndex: (in category 'header format') -----
  headerForSlots: numSlots format: formatField classIndex: classIndex 
  	"The header format in LSB is
  	 MSB:	| 8: slotSize			| (on a byte boundary)
  			| 2 bits				|
  			| 22: identityHash	| (on a word boundary)
  			| 3 bits				|
  			| 5: format			| (on a byte boundary)
  			| 2 bits				|
  			| 22: classIndex		| (on a word boundary) : LSB
  	 The remaining bits (7) need to be used for
  		isGrey
  		isMarked
  		isRemembered
  		isPinned
  		isImmutable
  	 leaving 2 unused bits."
+ 	^ (numSlots << self slotSizeFullShift)
- 	^ (numSlots << self slotSizeFullWordShift)
  	+ (formatField << self formatShift)
  	+ classIndex!

Item was added:
+ ----- Method: CogMemoryManager>>indexablePointersFormat (in category 'header format') -----
+ indexablePointersFormat
+ 	^3!

Item was added:
+ ----- Method: CogMemoryManager>>initFreeChunkWithSlots:at: (in category 'garbage collection') -----
+ initFreeChunkWithSlots: numSlots at: address 
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: CogMemoryManager>>initialize (in category 'initialization') -----
+ initialize
+ 	freeLists := Array new: NumFreeLists. "gets an extra element in C"!

Item was added:
+ ----- Method: CogMemoryManager>>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>
+ 	"image may be at a different address; adjust oops for new location"
+ 	self adjustAllOopsBy: bytesToShift.
+ 
+ 	self initializeOldSpaceFirstFree: endOfOldSpace. "initializes endOfMemory, freeStart"
+ 
+ 	specialObjectsOop := specialObjectsOop + bytesToShift.
+ 
+ 	"heavily used special objects"
+ 	nilObj		:= self splObj: NilObject.
+ 	falseObj	:= self splObj: FalseObject.
+ 	trueObj		:= self splObj: TrueObject.
+ 
+ 	"rootTableCount := 0.
+ 	rootTableOverflowed := false.
+ 	lowSpaceThreshold := 0.
+ 	signalLowSpace := false.
+ 	compStart := 0.
+ 	compEnd := 0.
+ 	fwdTableNext := 0.
+ 	fwdTableLast := 0.
+ 	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 added:
+ ----- Method: CogMemoryManager>>initializeOldSpaceFirstFree: (in category 'garbage collection') -----
+ initializeOldSpaceFirstFree: startOfFreeOldSpace
+ 	<var: 'startOfFreeOldSpace' type: #usqLong>
+ 	| freeOldStart freeChunk |
+ 	<var: 'freeOldStart' type: #usqLong>
+ 	1 to: NumFreeLists do:
+ 		[:i| freeLists at: i put: nil].
+ 	freeOldStart := startOfFreeOldSpace.
+ 	[endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue:
+ 		[freeChunk := self initFreeChunkWithSlots: (2 raisedTo: 32) / self wordSize at: freeOldStart.
+ 		self addToFreeList: freeChunk.
+ 		freeOldStart := self addressAfter: freeChunk].
+ 	freeChunk := self initFreeChunkWithSlots: endOfMemory - freeOldStart / self wordSize at: freeOldStart.
+ 	self addToFreeList: freeChunk!

Item was added:
+ ----- Method: CogMemoryManager>>initializePostBootstrap (in category 'simulation') -----
+ initializePostBootstrap
+ 	"The heap has just been bootstrapped into a modified newSpace occupying all of memory above newSPace (and the codeZone).
+ 	 Put things back to some kind of normalicy."
+ 	endOfOldSpace := freeStart.
+ 	freeStart := newSpaceStart!

Item was added:
+ ----- Method: CogMemoryManager>>lastPointerFormat (in category 'header format') -----
+ lastPointerFormat
+ 	^5!

Item was added:
+ ----- Method: CogMemoryManager>>lastPointerOf: (in category 'object enumeration') -----
+ lastPointerOf: oop 
+ 	"Answer the byte offset of the last pointer field of the given object.
+ 	 Works with CompiledMethods, as well as ordinary objects."
+ 	<api>
+ 	<inline: true>
+ 	<asmLabel: false>
+ 	| fmt header contextSize numLiterals |
+ 	<var: 'header' type: #usqLong>
+ 	header := self baseHeader: oop.
+ 	fmt := self formatOfHeader: header.
+ 	fmt <= self lastPointerFormat ifTrue:
+ 		[(fmt = self indexablePointersFormat
+ 		  and: [self isContextHeader: header]) ifTrue:
+ 			["contexts end at the stack pointer"
+ 			contextSize := coInterpreter fetchStackPointerOf: oop.
+ 			^CtxtTempFrameStart + contextSize * BytesPerOop].
+ 		^(self baseSlotSizeOf: oop) * BytesPerOop  "all pointers"].
+ 	fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
+ 
+ 	"CompiledMethod: contains both pointers and bytes"
+ 	numLiterals := coInterpreter literalCountOf: oop.
+ 	^numLiterals + LiteralStart * BytesPerOop!

Item was changed:
  ----- Method: CogMemoryManager>>nilFieldsOf: (in category 'primitive support') -----
  nilFieldsOf: obj 
+ 	0 to: (self baseSlotSizeOf: obj) - 1 do:
- 	0 to: (self rawSlotSizeOf: obj) - 1 do:
  		[:i|
  		self storePointerUnchecked: i ofObject: obj withValue: nilObj]!

Item was removed:
- ----- Method: CogMemoryManager>>rawSlotSizeOf: (in category 'object access') -----
- rawSlotSizeOf: oop
- 	<returnTypeC: #usqInt>
- 	| halfHeader slotSize |
- 	self flag: #endianness.
- 	halfHeader := self longAt: oop + 4.
- 	slotSize := halfHeader >> self slotSizeHalfWordShift bitAnd: self slotSizeMask.
- 	^slotSize = self slotSizeMask
- 		ifTrue: [self longAt: oop - self baseHeaderSize] "overflow slots; (2^32)-1 slots are plenty"
- 		ifFalse: [slotSize]!

Item was added:
+ ----- Method: CogMemoryManager>>slotSizeFullShift (in category 'header format') -----
+ slotSizeFullShift
+ 	^56!

Item was removed:
- ----- Method: CogMemoryManager>>slotSizeFullWordShift (in category 'header format') -----
- slotSizeFullWordShift
- 	^56!

Item was added:
+ ----- Method: CogMemoryManager>>slotSizeHalfShift (in category 'header format') -----
+ slotSizeHalfShift
+ 	^24!

Item was removed:
- ----- Method: CogMemoryManager>>slotSizeHalfWordShift (in category 'header format') -----
- slotSizeHalfWordShift
- 	^24!

Item was added:
+ ----- Method: CogMemoryManager>>splObj: (in category 'interpreter access') -----
+ splObj: index
+ 	<api>
+ 	<inline: true>
+ 	"Return one of the objects in the specialObjectsArray"
+ 	^self fetchPointer: index ofObject: specialObjectsOop!

Item was added:
+ ----- Method: CogMemoryManager32Bits>>addressAfter: (in category 'object enumeration') -----
+ addressAfter: objOop
+ 	"Answer the address immediately following an object."
+ 	| rawSlotSize slotBytes |
+ 	rawSlotSize := self baseSlotSizeOf: objOop.
+ 	slotBytes := rawSlotSize = 0
+ 					ifTrue: [self allocationUnit]
+ 					ifFalse: [rawSlotSize + (rawSlotSize bitAnd: 1) << self shiftForWord].
+ 	^objOop + self baseHeaderSize + slotBytes!

Item was added:
+ ----- Method: CogMemoryManager32Bits>>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 isImmediate: fieldOop) ifFalse:
+ 			[self longAt: fieldAddr put: fieldOop + offsetBytes].
+ 		 fieldAddr := fieldAddr - BytesPerOop]!

Item was changed:
  ----- Method: CogMemoryManager32Bits>>allocateSlots:format:classIndex: (in category 'allocation') -----
  allocateSlots: numSlots format: formatField classIndex: classIndex
  	| numBytes newObj |
  	"Object headers are 8 bytes in length if the slot size fits in the slot size field (max implies overflow),
  	 16 bytes otherwise (slot size in preceeding word).
  	 Objects always have at least one slot, for the forwarding pointer,
  	 and are multiples of 8 bytes in length."
  	numSlots >= self slotSizeMask
  		ifTrue:
  			[newObj := freeStart + self baseHeaderSize.
  			 numBytes := self baseHeaderSize + self baseHeaderSize "double header"
  						+ (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit"
  		ifFalse:
  			[newObj := freeStart.
  			 numBytes := self baseHeaderSize "single header"
  						+ (numSlots <= 1
  							ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
  							ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit"
  	self assert: numBytes \\ self allocationUnit = 0.
  	freeStart + numBytes > scavengeThreshold ifTrue:
  		[freeStart + numBytes > newSpaceLimit ifTrue:
  			[^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex].
  		 self scheduleScavenge].
  	numSlots >= self slotSizeMask
  		ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  			[self flag: #endianness.
  			 self longAt: freeStart put: numSlots.
+ 			 self longAt: freeStart + 4 put: self slotSizeMask << self slotSizeHalfShift.
- 			 self longAt: freeStart + 4 put: self slotSizeMask << self slotSizeHalfWordShift.
  			 self longLongAt: newObj put: (self headerForSlots: self slotSizeMask format: formatField classIndex: classIndex)]
  		ifFalse:
  			[self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
  	self assert: numBytes \\ self allocationUnit = 0.
  	self assert: newObj \\ self allocationUnit = 0.
  	freeStart := freeStart + numBytes.
  	^newObj!

Item was added:
+ ----- Method: CogMemoryManager32Bits>>initFreeChunkWithSlots:at: (in category 'garbage collection') -----
+ initFreeChunkWithSlots: numSlots at: address 
+ 	self flag: #endianness.
+ 	self longAt: address put: numSlots;
+ 		longAt: address + 4 put: self slotSizeMask << self slotSizeHalfShift;
+ 		longAt: address + 8 put: 0; "0's classIndex; 0 = classIndex of free chunks"
+ 		longAt: address + 12 put: self slotSizeMask << self slotSizeHalfShift.
+ 	^address + 8!

Item was changed:
  ----- Method: CogMemoryManager32Bits>>objectAfter: (in category 'object enumeration') -----
  objectAfter: objOop
  	"Object parsing.
  	1. all objects have at least a word following the header, for a forwarding pointer.
  	2. objects with an overflow size have a preceeing word with a saturated slotSize.  If the word following
  	    an object doesn't have a saturated size field it must be a single-header object.  If the word following
  	   does have a saturated slotSize it must be the overflow size word."
+ 	| followingWordAddress followingWord |
+ 	followingWordAddress := self addressAfter: objOop.
- 	| rawSlotSize slotBytes followingWordAddress followingWord |
- 	rawSlotSize := self rawSlotSizeOf: objOop.
- 	slotBytes := rawSlotSize = 0
- 					ifTrue: [self allocationUnit]
- 					ifFalse: [rawSlotSize + (rawSlotSize bitAnd: 1) << self shiftForWord].
- 	followingWordAddress := objOop + self baseHeaderSize + slotBytes.
  	followingWordAddress >= freeStart ifTrue:
  		[^freeStart].
  	self flag: #endianness.
  	followingWord := self longAt: followingWordAddress + 4.
+ 	^followingWord >> self slotSizeHalfShift = self slotSizeMask
- 	^followingWord >> self slotSizeHalfWordShift = self slotSizeMask
  		ifTrue: [followingWordAddress + self baseHeaderSize]
  		ifFalse: [followingWordAddress]!

Item was added:
+ ----- Method: CogMemoryManager64Bits>>addressAfter: (in category 'object enumeration') -----
+ addressAfter: objOop
+ 	"Answer the address immediately following an object."
+ 	| rawSlotSize slotBytes |
+ 	rawSlotSize := self baseSlotSizeOf: objOop.
+ 	slotBytes := rawSlotSize = 0
+ 					ifTrue: [self allocationUnit]
+ 					ifFalse: [rawSlotSize << self shiftForWord].
+ 	^objOop + self baseHeaderSize + slotBytes!

Item was added:
+ ----- Method: CogMemoryManager64Bits>>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 isGreaterThan: oop] whileTrue:
+ 		[fieldOop := self longAt: fieldAddr.
+ 		 (self isIntegerObject: fieldOop) ifFalse:
+ 			[self longLongAt: fieldAddr put: fieldOop + offsetBytes].
+ 		 fieldAddr := fieldAddr - BytesPerWord]!

Item was changed:
  ----- Method: CogMemoryManager64Bits>>allocateSlots:format:classIndex: (in category 'allocation') -----
  allocateSlots: numSlots format: formatField classIndex: classIndex
  	| numBytes newObj |
  	"Object headers are 8 bytes in length if the slot size fits in the slot size field (max implies overflow),
  	 16 bytes otherwise (slot size in preceeding word).
  	 Objects always have at least one slot, for the forwarding pointer,
  	 and are multiples of 8 bytes in length."
  	numSlots >= self slotSizeMask
  		ifTrue:
  			[numSlots > 16rffffffff ifTrue:
  				[^nil].
  			 newObj := freeStart + self baseHeaderSize.
  			 numBytes := (self baseHeaderSize + self baseHeaderSize) "double header"
  						+ (numSlots * self bytesPerSlot)]
  		ifFalse:
  			[newObj := freeStart.
  			 numBytes := self baseHeaderSize "single header"
  						+ (numSlots < 1
  							ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
  							ifFalse: [numSlots * self bytesPerSlot])].
  	
  	freeStart + numBytes > scavengeThreshold ifTrue:
  		[freeStart + numBytes > newSpaceLimit ifTrue:
  			[^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex].
  		 self scheduleScavenge].
  	numSlots >= self slotSizeMask
  		ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  			[self flag: #endianness.
  			 self longAt: freeStart put: numSlots.
+ 			 self longAt: freeStart + 4 put: self slotSizeMask << self slotSizeHalfShift.
- 			 self longAt: freeStart + 4 put: self slotSizeMask << self slotSizeHalfWordShift.
  			 self longLongAt: newObj put: (self headerForSlots: self slotSizeMask format: formatField classIndex: classIndex)]
  		ifFalse:
  			[self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
  		freeStart := freeStart + numBytes.
  	^newObj!

Item was added:
+ ----- Method: CogMemoryManager64Bits>>initFreeChunkWithSlots:at: (in category 'garbage collection') -----
+ initFreeChunkWithSlots: numSlots at: address 
+ 	self flag: #endianness.
+ 	self longAt: address put: self slotSizeMask << self slotSizeFullShift + numSlots;
+ 		longAt: address + 8 put: self slotSizeMask << self slotSizeFullShift. "0's classIndex; 0 = classIndex of free chunks"
+ 	^address + 8!

Item was changed:
  ----- Method: CogMemoryManager64Bits>>objectAfter: (in category 'object enumeration') -----
  objectAfter: objOop
  	"Object parsing.
  	1. all objects have at least a word following the header, for a forwarding pointer.
  	2. objects with an overflow size have a preceeing word with a saturated slotSize.  If the word following
  	    an object doesn't have a saturated size field it must be a single-header object.  If the word following
  	   does have a saturated slotSize it must be the overflow size word."
  	| followingWordAddress followingWord |
+ 	followingWordAddress := self addressAfter: objOop.
+ 	followingWordAddress >= freeStart ifTrue:
+ 		[^freeStart].
- 	followingWordAddress := objOop
- 							+ self baseHeaderSize
- 							+ ((self rawSlotSizeOf: objOop) << self shiftForWord max: self allocationUnit).
  	self flag: #endianness.
  	followingWord := self longAt: followingWordAddress + 4.
+ 	^followingWord >> self slotSizeHalfShift = self slotSizeMask
- 	^followingWord >> self slotSizeHalfWordShift = self slotSizeMask
  		ifTrue: [followingWordAddress + self baseHeaderSize]
  		ifFalse: [followingWordAddress]!

Item was changed:
  ----- Method: CogVMSimulator>>openOn:extraMemory: (in category 'initialization') -----
  openOn: fileName extraMemory: extraBytes
  	"InterpreterSimulator new openOn: 'clone.im' extraMemory: 100000"
  
  	| f version headerSize count heapSize oldBaseAddr bytesToShift swapBytes hdrNumStackPages
  	 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 nextLongFrom: f swap: swapBytes.
  	heapSize := self nextLongFrom: f swap: swapBytes.  "first unused location in heap"
  	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 nextLongFrom: f swap: swapBytes.
  	headerFlags			:= self nextLongFrom: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	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.
- 	stackPages := self stackPagesClass new. "Temporary for computeStackZoneSize"
  	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.
  	hdrEdenBytes	:= self nextLongFrom: f swap: swapBytes.
  	objectMemory edenBytes: (desiredEdenBytes ~= 0
  						ifTrue: [desiredEdenBytes]
  						ifFalse:
  							[hdrEdenBytes = 0
  									ifTrue: [objectMemory defaultEdenBytes]
  									ifFalse: [hdrEdenBytes]]).
  	desiredEdenBytes := hdrEdenBytes.
  	"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 setMemoryLimit:   heapBase
  						+ heapSize
  						+ objectMemory edenBytes
  						+ self interpreterAllocationReserveBytes
  						+ extraBytes.
  
  	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: heapBase // 4 + 1 count: heapSize // 4.
  	count ~= (heapSize // 4) ifTrue: [self halt].
  	]
  		ensure: [f close].
  	objectMemory setEndOfMemory: heapBase + heapSize.
  	self moveMethodCacheToMemoryAt: cogCodeSize + stackZoneSize.
  	self movePrimTraceLogToMemoryAt: cogCodeSize + stackZoneSize + methodCacheSize.
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	bytesToShift := objectMemory startOfMemory - oldBaseAddr.  "adjust pointers for zero base address"
  	Utilities informUser: 'Relocating object pointers...'
  				during: [self initializeInterpreter: bytesToShift].
  	self initializeCodeGenerator!

Item was changed:
  ----- Method: InterpreterStackPages>>initializeStack:numSlots:pageSize: (in category 'initialization') -----
  initializeStack: theStackPages numSlots: stackSlots pageSize: slotsPerPage
  	"Initialize the stack pages.  For testing I want stack addresses to be disjoint from
  	 normal memory addresses so stack addresses are negative.  The first address is
  	 -pageSize bytes.  So for example if there are 1024 bytes per page and 3 pages
  	 then the pages are organized as
  
  		byte address: -1024 <-> -2047 | -2048 <-> -3071 | -3072 <-> -4096 |
  							page 3			page 2			page 1
  		mem index:        769 <-> 513  |     512 <->  257  |   256 <->        1 |
  
  	 The byte address is the external address corresponding to a real address in the VM.
  	 mem index is the index in the memory Array holding the stack, an index internal to
  	 the stack pages.  The first stack page allocated will be the last page in the array of pages
  	 at the highest effective address.  Its base address be -1024  and grow down towards -2047."
  
  	"The lFoo's are to get around the foo->variable scheme in the C call to allocStackPages below."
  	<var: #theStackPages type: #'char *'>
  	| page structStackPageSize pageStructBase count |
  	<var: #page type: #'StackPage *'>
  	<var: #pageStructBase type: #'char *'>
  	self cCode: ''
  		inSmalltalk:
  			[self assert: stackMemory size = stackSlots.
- 			 self assert: stackMemory size - self extraStackBytes \\ slotsPerPage = 0.
  			 self assert: stackMemory == theStackPages].
  	stackMemory := theStackPages. "For initialization in the C code."
  	self cCode: '' inSmalltalk: [pageSizeInSlots := slotsPerPage].
  	structStackPageSize := interpreter sizeof: InterpreterStackPage.
  	bytesPerPage := slotsPerPage * BytesPerWord.
  	numPages := stackSlots // (slotsPerPage + (structStackPageSize / BytesPerWord)).
  
  	"Because stack pages grow down baseAddress is at the top of a stack page and so to avoid
  	 subtracting BytesPerWord from baseAddress and lastAddress in the init loop below we simply
  	 push the stackPage array up one word to avoid the overlap.  This word is extraStackBytes."
  	pageStructBase := theStackPages + (numPages * bytesPerPage) + BytesPerWord.
  	pages := self cCode: '(StackPage *)pageStructBase'
  				  inSmalltalk:
  						[pageStructBase class.
  						 (1 to: numPages) collect: [:i| InterpreterStackPage new]].
  
  	"Simulation only.  Since addresses are negative the offset is positive.  To make all
  	 stack addresses negative we make the offset a page more than it needs to be so the
  	 address of the last slot in memory (the highest address in the stack, or its start) is
  		- pageByteSize
  	 and the address of the first slot (the lowest address, or its end) is
  		- pageByteSize * (numPages + 1)"
  	self cCode: '' inSmalltalk: [indexOffset := (numPages + 1) * slotsPerPage].
  	"make sure there's enough headroom"
  	self assert: interpreter stackPageByteSize - interpreter stackLimitBytes - interpreter stackLimitOffset
  				>= interpreter stackPageHeadroom.
  	0 to: numPages - 1 do:
  		[:index|
  		 page := self stackPageAt: index.
  		 page
  			lastAddress: (self cCode: '(char *)theStackPages + (index * GIV(bytesPerPage))'
  							inSmalltalk: [(index * slotsPerPage - indexOffset) * BytesPerWord]);
  			baseAddress: (page lastAddress + bytesPerPage);
  			stackLimit: page baseAddress - interpreter stackLimitBytes;
  			realStackLimit: page stackLimit;
  			baseFP: 0;
  			nextPage: (self stackPageAt: (index = (numPages - 1) ifTrue: [0] ifFalse: [index + 1]));
  			prevPage: (self stackPageAt: (index = 0 ifTrue: [numPages - 1] ifFalse: [index - 1]))].
  	self cCode: ''
  		inSmalltalk:
  			[| lowestAddress highestAddress |
  			lowestAddress := (pages at: 1) lastAddress + BytesPerWord.
  			highestAddress := (pages at: numPages) baseAddress.
  			"see InterpreterStackPages>>longAt:"
  			self assert: lowestAddress // BytesPerWord + indexOffset = 1.
  			self assert: highestAddress // BytesPerWord + indexOffset = (numPages * slotsPerPage)].
  
  	"The overflow limit is the amount of stack to retain when moving frames from an overflowing
  	 stack to reduce thrashing.  See stackOverflowOrEvent:mayContextSwitch:"
  	page := self stackPageAt: 0.
  	overflowLimit := page baseAddress - page realStackLimit * 3 // 5.
  
  	0 to: numPages - 1 do:
  		[:index|
  		 page := self stackPageAt: index.
  		 self assert: (self pageIndexFor: page baseAddress) == index.
  		 self assert: (self pageIndexFor: page baseAddress - (slotsPerPage - 1 * BytesPerWord)) == index.
  		 self assert: (self stackPageFor: page baseAddress) == page.
  		 self assert: (self stackPageFor: page stackLimit) == page.
  		 self cCode: ''
  			inSmalltalk:
  				[| memIndex |
  				 memIndex := index * slotsPerPage + 1. "this is memIndex in the block above"
  				 self assert: (self memIndexFor: (self oopForPointer: page baseAddress))
  							== (memIndex + slotsPerPage - 1).
  				 index < (numPages - 1) ifTrue:
  					[self assert: (self stackPageFor: page baseAddress + BytesPerWord) == (self stackPageAt: index + 1)]].
  		self assert: (page trace: -1) ~= 0 "for assert checking of the page tracing flags. -1 == invalid state"].
  
  	mostRecentlyUsedPage := self stackPageAt: 0.
  	page := mostRecentlyUsedPage.
  	count := 0.
  	[| theIndex |
  	 count := count + 1.
  	 theIndex := self pageIndexFor: page baseAddress.
  	 self assert: (self stackPageAt: theIndex) == page.
  	 self assert: (self pageIndexFor: page baseAddress) == theIndex.
  	 self assert: (self pageIndexFor: page stackLimit) == theIndex.
  	 self assert: (self pageIndexFor: page lastAddress + BytesPerWord) == theIndex.
  	 (page := page nextPage) ~= mostRecentlyUsedPage] whileTrue.
  	self assert: count == numPages.
  	self assert: self pageListIsWellFormed!

Item was changed:
  ----- Method: ObjectMemory>>adjustFieldsAndClassOf:by: (in category 'initialization') -----
  adjustFieldsAndClassOf: oop by: offsetBytes 
  	"Adjust all pointers in this object by the given offset."
  	| fieldAddr fieldOop classHeader newClassOop |
  	<inline: true>
  	<asmLabel: false>
  	offsetBytes = 0 ifTrue: [^nil].
  	fieldAddr := oop + (self lastPointerOf: oop).
  	[self oop: fieldAddr isGreaterThan: oop]
  		whileTrue: [fieldOop := self longAt: fieldAddr.
  			(self isIntegerObject: fieldOop)
  				ifFalse: [self longAt: fieldAddr put: fieldOop + offsetBytes].
+ 			fieldAddr := fieldAddr - BytesPerOop].
- 			fieldAddr := fieldAddr - BytesPerWord].
  	(self headerType: oop) ~= HeaderTypeShort
  		ifTrue: ["adjust class header if not a compact class"
  			classHeader := self longAt: oop - BytesPerWord.
  			newClassOop := (classHeader bitAnd: AllButTypeMask) + offsetBytes.
  			self longAt: oop - BytesPerWord put: (newClassOop bitOr: (classHeader bitAnd: TypeMask))]!

Item was changed:
  ----- Method: StackInterpreter>>computeStackZoneSize (in category 'initialization') -----
  computeStackZoneSize
+ 	self cCode: []
+ 		inSmalltalk: [stackPages ifNil: [stackPages := self stackPagesClass new]].
+ 	^numStackPages * ((self sizeof: InterpreterStackPage) + self stackPageByteSize)
- 	"In C the StackPage structs live next to the actual stack pages in the alloca'ed stack
- 	 zone.  In simulation these live in some dictionary and don't exist in the memory."
- 	^numStackPages * ((self cCode: [self sizeof: InterpreterStackPage] inSmalltalk: [0])
- 						+ self stackPageByteSize)
  	 + stackPages extraStackBytes!

Item was changed:
  ----- Method: StackInterpreter>>initStackPages (in category 'initialization') -----
  initStackPages
  	"Initialize the stackPages.  This version is only for simulation
  	 because Slang refuses to inline it, which makes the alloca invalid."
  	| stackPageBytes stackPagesBytes theStackMemory |
  	stackPageBytes := self stackPageByteSize.
  	stackPagesBytes := self computeStackZoneSize.
  	theStackMemory := self
+ 							cCode: [self alloca: stackPagesBytes]
+ 							inSmalltalk: [stackPages initializeWithByteSize: stackPagesBytes for: self].
- 						cCode: [self alloca: stackPagesBytes]
- 						inSmalltalk:
- 							[stackPages := self stackPagesClass new.
- 							 stackPages initializeWithByteSize: stackPagesBytes for: self].
  	self cCode: [self me: theStackMemory ms: 0 et: stackPagesBytes].
  	stackPages
  		initializeStack: theStackMemory
  		numSlots: stackPagesBytes / BytesPerWord
  		pageSize: stackPageBytes / BytesPerWord!

Item was changed:
  ----- Method: StackInterpreter>>initStackPagesAndInterpret (in category 'initialization') -----
  initStackPagesAndInterpret
  	"Initialize the stack pages and enter interpret. Use alloca'ed memory so that when
  	 we have a JIT its stack pointer will be on the native stack since alloca allocates
  	 memory on the stack. Certain thread systems use the native stack pointer as the
  	 frame ID so putting the stack anywhere else can confuse the thread system."
  
  	"This should be in its own initStackPages method but Slang can't inline
  	 C code strings."
  	| stackPageBytes stackPagesBytes theStackMemory |
  	<var: #theStackMemory type: #'void *'>
  	stackPageBytes := self stackPageByteSize.
  	stackPagesBytes := self computeStackZoneSize.
  	theStackMemory := self
+ 							cCode: [self alloca: stackPagesBytes]
+ 							inSmalltalk: [stackPages initializeWithByteSize: stackPagesBytes for: self].
- 						cCode: [self alloca: stackPagesBytes]
- 						inSmalltalk:
- 							[stackPages := self stackPagesClass new.
- 							 stackPages initializeWithByteSize: stackPagesBytes for: self].
  	self cCode: [self me: theStackMemory ms: 0 et: stackPagesBytes].
  	stackPages
  		initializeStack: theStackMemory
  		numSlots: stackPagesBytes / BytesPerWord
  		pageSize: stackPageBytes / BytesPerWord.
  
  	"Once the stack pages are initialized we can continue to bootstrap the system."
  	self loadInitialContext.
  	"We're ready for the heartbeat (poll interrupt)"
  	self ioInitHeartbeat.
  	self interpret.
  	^nil!

Item was changed:
  ----- Method: StackInterpreterSimulator>>openOn:extraMemory: (in category 'initialization') -----
  openOn: fileName extraMemory: extraBytes
  	"StackInterpreterSimulator new openOn: 'clone.im' extraMemory: 100000"
  
  	| f version headerSize count oldBaseAddr bytesToShift swapBytes
  	  hdrNumStackPages hdrEdenBytes headerFlags |
  	"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 nextLongFrom: f swap: swapBytes.
  	objectMemory setEndOfMemory: (self nextLongFrom: f swap: swapBytes).  "first unused location in heap"
  	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 nextLongFrom: f swap: swapBytes.
  	headerFlags			:= self nextLongFrom: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	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.
- 	stackPages := self stackPagesClass new. "Temporary for computeStackZoneSize"
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 Preserve it to be polite to images run on Cog."
  	theUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	hdrEdenBytes		:= self nextLongFrom: f swap: swapBytes.
  	objectMemory edenBytes: (hdrEdenBytes = 0
  							ifTrue: [objectMemory defaultEdenBytes]
  							ifFalse: [hdrEdenBytes]).
  	desiredEdenBytes := hdrEdenBytes.
  	"allocate interpreter memory"
  	objectMemory setMemoryLimit: objectMemory endOfMemory + extraBytes + objectMemory edenBytes + self interpreterAllocationReserveBytes.
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	f position: headerSize.
  	objectMemory memory: (Bitmap new: objectMemory memoryLimit // 4).
  	count := f readInto: objectMemory memory startingAt: 1 count: objectMemory endOfMemory // 4.
  	count ~= (objectMemory endOfMemory // 4) ifTrue: [self halt].
  	]
  		ensure: [f close].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	objectMemory initialize.
  	bytesToShift := objectMemory startOfMemory - oldBaseAddr.  "adjust pointers for zero base address"
  	Utilities informUser: 'Relocating object pointers...'
  				during: [self initializeInterpreter: bytesToShift].
  !