[Vm-dev] VM Maker: VMMaker-oscog-EstebanLorenzano.155.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Apr 5 09:00:35 UTC 2012


Esteban Lorenzano uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-oscog-EstebanLorenzano.155.mcz

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

Name: VMMaker-oscog-EstebanLorenzano.155
Author: EstebanLorenzano
Time: 5 April 2012, 10:57:51 am
UUID: c53d1f34-009e-425c-9f88-398f8d39c5e8
Ancestors: VMMaker-oscog-EstebanLorenzano.150, VMMaker.oscog-eem.154

merged with latest from Eliot (emm.154)

=============== Diff against VMMaker-oscog-EstebanLorenzano.150 ===============

Item was changed:
  ----- Method: CCodeGenerator>>emitGlobalCVariablesOn: (in category 'C code generator') -----
  emitGlobalCVariablesOn: aStream
  	"Store the global variable declarations on the given stream."
  
  	aStream cr; nextPutAll: '/*** Global Variables ***/'; cr.
  	(self sortStrings: (variables select: [:v| vmClass mustBeGlobal: v])) do:
  		[:var | | varString decl |
  		varString := var asString.
  		decl := variableDeclarations at: varString ifAbsent: ['sqInt ' , varString].
+ 		decl first == $# "support cgen var: #bytecodeSetSelector declareC: '#define bytecodeSetSelector 0' hack"
+ 			ifTrue:
+ 				[aStream nextPutAll: decl; cr]
+ 			ifFalse:
+ 				[((decl includesSubString: ' private ')
+ 				  or: [decl beginsWith: 'static']) ifFalse: "work-around hack to prevent localization of variables only referenced once."
+ 					[(decl includes: $=) ifTrue:
+ 						[decl := decl copyFrom: 1 to: (decl indexOf: $=) - 1].
+ 					aStream
+ 						nextPutAll: decl;
+ 						nextPut: $;;
+ 						cr]]].
- 		((decl includesSubString: ' private ')
- 		  or: [decl beginsWith: 'static']) ifFalse: "work-around hack to prevent localization of variables only referenced once."
- 			[(decl includes: $=) ifTrue:
- 				[decl := decl copyFrom: 1 to: (decl indexOf: $=) - 1].
- 			aStream
- 				nextPutAll: decl;
- 				nextPut: $;;
- 				cr]].
  	aStream cr!

Item was changed:
  ----- Method: CoInterpreter>>ceDynamicSuperSend:to:numArgs: (in category 'trampolines') -----
  ceDynamicSuperSend: selector to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked dynamic super send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	<option: #NewspeakVM>
  	| class canLinkCacheTag errSelIdx cogMethod newCogMethod mClassMixin mixinApplication |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	self sendBreak: selector + BaseHeaderSize
  		point: (objectMemory lengthOf: selector)
  		receiver: rcvr.
  	mClassMixin := self mMethodClass.
  	mixinApplication := self 
  							findApplicationOfTargetMixin: mClassMixin
  							startingAtBehavior: (objectMemory fetchClassOf: rcvr).
  	self assert: (objectMemory lengthOf: mixinApplication) > (InstanceSpecificationIndex + 1).
  	lkupClass := self superclassOf: mixinApplication.
+ 	class := objectMemory fetchClassOf: rcvr.
- 	class := self fetchClassOf: rcvr.
  	canLinkCacheTag := (objectMemory isYoungObject: class) not or: [cogit canLinkToYoungClasses].
  	"We set the messageSelector and lkupClass for executeMethod below since things
  	 like the at cache read messageSelector and lkupClass and so they cannot be left stale."
  	messageSelector := selector.
  	lkupClass := self superclassOf: mixinApplication.
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector class: lkupClass)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[(errSelIdx := self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: lkupClass.
  				"NOTREACHED"
  				self assert: false]].
  	"Method found and has a cog method.  Attempt to link to it."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
  		 cogMethod selector = objectMemory nilObject ifTrue:
  			[cogit setSelectorOf: cogMethod to: selector].
  		 "Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the correct
  		  selector.  If not, try and compile a new method with the correct selector."
  		 cogMethod selector ~= selector ifTrue:
  			[self assert: (self methodClassAssociationOf: newMethod) = objectMemory nilObject.
  			 newCogMethod := cogit cog: newMethod selector: selector.
  			 newCogMethod ifNotNil:
  				[cogMethod := newCogMethod]].
  		 (cogMethod selector = selector
  		 and: [canLinkCacheTag]) ifTrue:
  			[cogit
  				linkSendAt: (stackPages longAt: stackPointer)
  				in: (self mframeHomeMethod: framePointer)
  				to: cogMethod
  				offset: cogit dynSuperEntryOffset
  				receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
  		 self assert: false
  		 "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>mapVMRegisters (in category 'object memory support') -----
  mapVMRegisters
  	"Map the oops in the interpreter's vm ``registers'' to their new values 
  	 during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops."
  	| mapInstructionPointer |
+ 	"i.e. interpreter instructionPointer in method as opposed to machine code?"
+ 	(mapInstructionPointer := instructionPointer > method) ifTrue:
- 	mapInstructionPointer := instructionPointer > method.
- 	mapInstructionPointer ifTrue:
  		[instructionPointer := instructionPointer - method]. "*rel to method"
+ 	method := (objectMemory remap: method).
- 	self setMethod: (objectMemory remap: method).
  	mapInstructionPointer ifTrue:
  		[instructionPointer := instructionPointer + method]. "*rel to method"
  	messageSelector := objectMemory remap: messageSelector.
  	(objectMemory isIntegerObject: newMethod) ifFalse:
  		[newMethod := objectMemory remap: newMethod].
  	lkupClass := objectMemory remap: lkupClass!

Item was changed:
  ----- Method: CoInterpreter>>updateStateOfSpouseContextForFrame:WithSP: (in category 'frame access') -----
  updateStateOfSpouseContextForFrame: theFP WithSP: theSP
  	"Update the frame's spouse context with the frame's current state except for the
  	 sender and instruction pointer, which are used to mark the context as married."
+ 	| theContext tempIndex pointer argsPointer |
- 	| theContext tempIndex pointer |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	<var: #pointer type: #'char *'>
+ 	<var: #argsPointer type: #'char *'>
  	self assert: (self frameHasContext: theFP).
  	theContext := self frameContext: theFP.
  	self assert: (self isContext: theContext).
  	self assert: (self frameReceiver: theFP)
  				= (objectMemory fetchPointer: ReceiverIndex ofObject: theContext).
  	(self isMachineCodeFrame: theFP)
  		ifTrue:
  			[tempIndex := self mframeNumArgs: theFP.
  			 pointer := theFP + FoxMFReceiver - BytesPerWord]
  		ifFalse:
  			[tempIndex := self iframeNumArgs: theFP.
  			 pointer := theFP + FoxIFReceiver - BytesPerWord].
+ 	"update the arguments. this would appear not to be strictly necessary, but is for two reasons.
+ 	 First, the fact that arguments are read-only is only as convention in the Smalltalk compiler;
+ 	 other languages may choose to modify arguments.
+ 	 Second, the Squeak runUntilErrorOrReturnFrom: nightmare pops the stack top, which may, in
+ 	 certain circumstances, be the last argument, and hence the last argument may not have been
+ 	 stored into the context."
+ 	argsPointer := theFP + (self frameStackedReceiverOffsetNumArgs: tempIndex).
+ 	1 to: tempIndex do:
+ 		[:i|
+ 		argsPointer := argsPointer - BytesPerWord.
+ 		self assert: (objectMemory addressCouldBeOop: (stackPages longAt: argsPointer)).
+ 		 objectMemory storePointer: ReceiverIndex + i
+ 			ofObject: theContext
+ 			withValue: (stackPages longAt: argsPointer)].
+ 	"now update the non-argument stack contents."
  	[pointer >= theSP] whileTrue:
  		[self assert: (objectMemory addressCouldBeOop: (stackPages longAt: pointer)).
  		 tempIndex := tempIndex + 1.
  		 objectMemory storePointer: ReceiverIndex + tempIndex
  			ofObject: theContext
  			withValue: (stackPages longAt: pointer).
  		 pointer := pointer - BytesPerWord].
  	self assert: ReceiverIndex + tempIndex < (objectMemory lengthOf: theContext).
  	objectMemory storePointerUnchecked: StackPointerIndex
  		ofObject: theContext
  		withValue: (objectMemory integerObjectOf: tempIndex)!

Item was changed:
  ----- Method: CogVMSimulator>>ceMNUFromPICMNUMethod:receiver: (in category 'trampolines') -----
  ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr
+ 	"self halt."
- 	self halt.
  	^super ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr!

Item was removed:
- ----- Method: CogVMSimulator>>printCurrPageFrames (in category 'debug printing') -----
- printCurrPageFrames
- 	self printFrameAndCallers: localFP SP: localSP!

Item was changed:
  ----- Method: Cogit>>closedPICRefersToUnmarkedObject: (in category 'garbage collection') -----
  closedPICRefersToUnmarkedObject: cPIC
  	"Answer if the ClosedPIC refers to any unmarked objects or freed/freeable target methods,
  	 applying markAndTraceOrFreeCogMethod:firstVisit: to those targets to determine if freed/freeable."
  	<var: #cPIC type: #'CogMethod *'>
  	| pc offsetToLiteral object entryPoint targetMethod |
  	<var: #targetMethod type: #'CogMethod *'>
  	(objectMemory isMarked: cPIC selector)  ifFalse:
  		[^true].
  	pc := cPIC asInteger + firstCPICCaseOffset.
  	"First jump is unconditional; subsequent ones are conditional"
  	offsetToLiteral := backEnd jumpLongByteSize.
  	1 to: cPIC cPICNumCases do:
  		[:i|
  		object := backEnd literalBeforeFollowingAddress: pc - offsetToLiteral - backEnd loadLiteralByteSize.
  		((objectRepresentation couldBeObject: object)
  		 and: [(objectMemory isMarked: object) not]) ifTrue:
  			[^true].
  		object := backEnd literalBeforeFollowingAddress: pc - offsetToLiteral.
  		((objectRepresentation couldBeObject: object)
+ 		 and: [(objectMemory isMarked: object) not]) ifTrue:
- 		 and: [(coInterpreter isMarked: object) not]) ifTrue:
  			[^true].
  		entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
  		"Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
  		(entryPoint asUnsignedInteger < cPIC asUnsignedInteger
  		 or: [entryPoint asUnsignedInteger > (cPIC asUnsignedInteger + cPIC blockSize) asUnsignedInteger]) ifTrue:
  			[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  			 self assert: (targetMethod cmType = CMMethod
  						or: [targetMethod cmType = CMFree]).
  			 (self markAndTraceOrFreeCogMethod: targetMethod
  				  firstVisit: targetMethod asUnsignedInteger > pc asUnsignedInteger) ifTrue:
  				[^true]].
  		offsetToLiteral := backEnd jumpLongConditionalByteSize.
  		pc := pc + cPICCaseSize].
  	^false!

Item was changed:
  ----- Method: Cogit>>mapObjectReferencesInMachineCodeForBecome (in category 'garbage collection') -----
  mapObjectReferencesInMachineCodeForBecome
  	"Update all references to objects in machine code for a become.
+ 	 Unlike incrementalGC or fullGC a method that does not refer to young may
+ 	 refer to young as a result of the become operation.  Unlike incrementalGC
+ 	 or fullGC the reference from a Cog method to its methodObject *must not*
+ 	 change since the two are two halves of the same object."
- 	 Unlike incrementalGC or fullGC a method that does not refer to young
- 	 may refer to young as a result of the become operation."
  	| cogMethod hasYoungObj hasYoungObjPtr freedPIC |
  	<var: #cogMethod type: #'CogMethod *'>
  	hasYoungObj := false.
  	hasYoungObjPtr := self cCode: [(self addressOf: hasYoungObj) asInteger]
  							inSmalltalk: [CPluggableAccessor new
  											setObject: nil;
  											atBlock: [:obj :idx| hasYoungObj]
  											atPutBlock: [:obj :idx :val| hasYoungObj := val]].
  	codeModified := freedPIC := false.
  	self mapObjectReferencesInGeneratedRuntime.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[self assert: hasYoungObj not.
  		 cogMethod cmType ~= CMFree ifTrue:
  			[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
  			 cogMethod selector: (objectRepresentation remapOop: cogMethod selector)..
  			 cogMethod cmType = CMClosedPIC
  				ifTrue:
  					[((objectMemory isYoung: cogMethod selector)
  					   or: [self mapObjectReferencesInClosedPIC: cogMethod]) ifTrue:
  						[freedPIC := true.
  						 methodZone freeMethod: cogMethod]]
  				ifFalse:
  					[(objectMemory isYoung: cogMethod selector) ifTrue:
  						[hasYoungObj := true].
  					 cogMethod cmType = CMMethod ifTrue:
  						[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
- 						 cogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject).
  						 self assert: ((coInterpreter rawHeaderOf: cogMethod methodObject) = cogMethod asInteger
  									or: [(self noAssertMethodClassAssociationOf: cogMethod methodObject)
  											= objectMemory nilObject]).
  						 (objectMemory isYoung: cogMethod methodObject) ifTrue:
  							[hasYoungObj := true]].
  					 self mapFor: cogMethod
  						 performUntil: (self cppIf: NewspeakVM
  											ifTrue: [#remapNSIfObjectRef:pc:hasYoung: asSymbol]
  											ifFalse: [#remapIfObjectRef:pc:hasYoung: asSymbol])
  						 arg: hasYoungObjPtr.
  					 hasYoungObj
  						ifTrue:
  							[cogMethod cmRefersToYoung ifFalse:
  								[cogMethod cmRefersToYoung: true.
  								 methodZone addToYoungReferrers: cogMethod].
  							hasYoungObj := false]
  						ifFalse: [cogMethod cmRefersToYoung: false]]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	methodZone pruneYoungReferrers.
  	freedPIC ifTrue:
  		[self unlinkSendsToFree.
  		 codeModified := true].
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
  		[processor flushICacheFrom: codeBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: Interpreter class>>initializeWithOptions: (in category 'initialization') -----
  initializeWithOptions: optionsDictionary
  	"Interpreter initializeWithOptions: Dictionary new"
  
  	super initializeWithOptions: optionsDictionary.  "initialize ObjectMemory constants"
+ 	self initializeMiscConstantsWith: optionsDictionary. "must preceed other initialization."
- 	self initializeMiscConstants. "must preceed other initialization."
  	self initializeAssociationIndex.
  	self initializeBytecodeTable.
  	self initializeCaches.
  	self initializeCharacterIndex.
  	self initializeCharacterScannerIndices.
  	self initializeClassIndices.
  	self initializeCompilerHooks.
  	self initializeContextIndices.
  	self initializeDirectoryLookupResultCodes.
  	self initializeMessageIndices.
  	self initializeMethodIndices.
  	self initializePointIndices.
  	self initializePrimitiveTable.
  	self initializeSchedulerIndices.
  	self initializeSmallIntegers.
  	self initializeStreamIndices!

Item was added:
+ ----- Method: NewObjectMemory>>checkOkayOop: (in category 'debug support') -----
+ checkOkayOop: oop
+ 	"Verify that the given oop is legitimate. Check address, header, and size but not class.
+ 	 Answer true if OK.  Otherwise print reason and answer false."
+ 
+ 	<api>
+ 	<var: #oop type: #usqInt>
+ 	| sz type fmt unusedBit |
+ 
+ 	"address and size checks"
+ 	(self isIntegerObject: oop) ifTrue: [ ^true ].
+ 	(oop >= self startOfMemory and: [oop < freeStart])
+ 		ifFalse: [ self print: 'oop is not a valid address'; cr. ^false ].
+ 	((oop \\ BytesPerWord) = 0)
+ 		ifFalse: [ self print: 'oop is not a word-aligned address'; cr. ^false ].
+ 	sz := self sizeBitsOf: oop.
+ 	(oop + sz) < freeStart
+ 		ifFalse: [ self print: 'oop size would make it extend beyond the end of memory'; cr. ^false ].
+ 
+ 	"header type checks"
+ 	type := self headerType: oop.
+ 	type = HeaderTypeFree
+ 		ifTrue:  [ self print: 'oop is a free chunk, not an object'; cr. ^false ].
+ 	type = HeaderTypeShort ifTrue: [
+ 		(self compactClassIndexOf: oop) = 0
+ 			ifTrue:  [ self print: 'cannot have zero compact class field in a short header'; cr. ^false ].
+ 	].
+ 	type = HeaderTypeClass ifTrue: [
+ 		((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
+ 			ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
+ 	].
+ 	type = HeaderTypeSizeAndClass ifTrue: [
+ 		((oop >= (BytesPerWord*2)) and:
+ 		 [(self headerType: oop - (BytesPerWord*2)) = type and:
+ 		 [(self headerType: oop - BytesPerWord) = type]])
+ 			ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
+ 	].
+ 
+ 	"format check"
+ 	fmt := self formatOf: oop.
+ 	((fmt = 5) | (fmt = 7))
+ 		ifTrue:  [ self print: 'oop has an unknown format type'; cr. ^false ].
+ 
+ 	"mark and root bit checks"
+ 	unusedBit := 16r20000000.
+ 	BytesPerWord = 8
+ 		ifTrue:
+ 			[unusedBit := unusedBit << 16.
+ 			 unusedBit := unusedBit << 16].
+ 	((self longAt: oop) bitAnd: unusedBit) = 0
+ 		ifFalse: [ self print: 'unused header bit 30 is set; should be zero'; cr. ^false ].
+ "xxx
+ 	((self longAt: oop) bitAnd: MarkBit) = 0
+ 		ifFalse: [ self print: 'mark bit should not be set except during GC' ].
+ xxx"
+ 	(((self longAt: oop) bitAnd: RootBit) = 1 and:
+ 	 [oop >= youngStart])
+ 		ifTrue: [ self print: 'root bit is set in a young object'; cr. ^false ].
+ 	^true
+ !

Item was changed:
  ----- Method: NewObjectMemory>>fullGC (in category 'garbage collection') -----
  fullGC
  	"Do a mark/sweep garbage collection of the entire object memory. Free inaccessible objects but do not move them."
  
  	<inline: false>
  	fullGCLock > 0 ifTrue:
  		[self warning: 'aborting fullGC because fullGCLock > 0'.
  		 ^self].
  	self initializeFreeBlocksPreSweep.
  	self runLeakCheckerForFullGC: true.
  	self preGCAction: GCModeFull.
  	gcStartUsecs := self ioUTCMicrosecondsNow.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
  	self clearRootsTable.
+ 	self initWeakTableForIncrementalGC: false.
  	youngStart := self startOfMemory.  "process all of memory"
  	self markPhase: true.
  	"Sweep phase returns the number of survivors.
  	Use the up-to-date version instead the one from startup."
  	totalObjectCount := self sweepPhaseForFullGC.
  	self runLeakCheckerForFullGC: true.
  	self fullCompaction.
  	statFullGCs := statFullGCs + 1.
  	statGCEndUsecs := self ioUTCMicrosecondsNow.
  	statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
  	self capturePendingFinalizationSignals.
  
  	youngStart := freeStart.  "reset the young object boundary"
  	self postGCAction.
  	self runLeakCheckerForFullGC: true!

Item was changed:
  ----- Method: NewObjectMemory>>incrementalGC (in category 'garbage collection') -----
  incrementalGC
  	"Do a mark/sweep garbage collection of just the young object
  	area of object memory (i.e., objects above youngStart), using
  	the root table to identify objects containing pointers to
  	young objects from the old object area."
  	| survivorCount weDidGrow |
  	<inline: false>
  
  	rootTableCount >= RootTableSize ifTrue:
  		["root table overflow; cannot do an incremental GC (this should be very rare)"
  		 statRootTableOverflows := statRootTableOverflows + 1.
  		 ^self fullGC].
  
  	self initializeFreeBlocksPreSweep.
  	self runLeakCheckerForFullGC: false.
  
  	self preGCAction: GCModeIncr.
  	"incremental GC and compaction"
  
  	gcStartUsecs := self ioUTCMicrosecondsNow.
- 	weakRootCount := 0.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
+ 	self initWeakTableForIncrementalGC: true.
  	self markPhase: false.
  	self assert: weakRootCount <= WeakRootTableSize.
  	1 to: weakRootCount do:
  		[:i| self finalizeReference: (weakRoots at: i)].
  	survivorCount := self sweepPhase.
  	self runLeakCheckerForFullGC: false.
  	self incrementalCompaction.
  	statIncrGCs := statIncrGCs + 1.
  	statGCEndUsecs := self ioUTCMicrosecondsNow.
  	statIGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
  	statIncrGCUsecs := statIncrGCUsecs + statIGCDeltaUsecs.
  	self capturePendingFinalizationSignals.
  	
  	statRootTableCount  := rootTableCount.
  	statSurvivorCount := survivorCount.
  	weDidGrow := false.
  	(((survivorCount > tenuringThreshold)
  	 or: [rootTableCount >= RootTableRedZone])
  	 or: [forceTenureFlag == true]) ifTrue:
  		["move up the young space boundary if
  		  * there are too many survivors:
  			this limits the number of objects that must be
  			processed on future incremental GC's
  		  * we're about to overflow the roots table:
  			this limits the number of full GCs that may be caused
  			by root table overflows in the near future"
  		forceTenureFlag := false.
  		statTenures := statTenures + 1.
  		self clearRootsTable.
  		((self freeSize < growHeadroom)
  		 and: [gcBiasToGrow > 0]) ifTrue:
  			[self biasToGrow.
  			 weDidGrow := true].
  		youngStart := freeStart].
  	self postGCAction.
  	
  	self runLeakCheckerForFullGC: false.
  	weDidGrow ifTrue:
  		[self biasToGrowCheckGCLimit]!

Item was changed:
  ----- Method: NewObjectMemory>>lastPointerOf:header:recordWeakRoot: (in category 'object enumeration') -----
  lastPointerOf: oop header: header recordWeakRoot: recordWeakRoot "<Boolean>"
  	"Return the byte offset of the last pointer field of the given object.  
  	 Works with CompiledMethods, as well as ordinary objects. 
  	 Can be used even when the type bits are not correct.
  	 This is a version of lastPointerOf: for markAndTrace:.
  	 Already overridden to trace stack pages for the StackInterpreter.
  	 Override to ask coInterpreter to determine literalCount of methods.
  	"
  	
  	| fmt sz contextSize nonWeakCnt |
  	<inline: true>
  	<asmLabel: false>
  	fmt := self formatOfHeader: header.
  	fmt <= 4 ifTrue:
  		[fmt >= 3 ifTrue:
  			[fmt = 4 ifTrue:
  				[
+ 				(recordWeakRoot and: [weakRootCount >= 0]) ifTrue:
- 				recordWeakRoot ifTrue:
  					["And remember as weak root"
+ 					 (weakRootCount := weakRootCount + 1) <= WeakRootTableSize ifFalse:
+ 						[self error: 'weakRoots table overflow'].
- 					 weakRootCount := weakRootCount + 1.
- 					 self assert: weakRootCount <= WeakRootTableSize.
  					 weakRoots at: weakRootCount put: oop].
  				nonWeakCnt := self nonWeakFieldsOf: oop.
  				  
  				 " we deal with ephemerons separately"
  				(self isEphemeron: oop nonWeakFields: nonWeakCnt) 
  					ifTrue: [ ^ self lastPointerOfEphemeron: oop nonWeakFields: nonWeakCnt ].
  				"Do not trace the object's indexed fields if it's a weak class"
  				^nonWeakCnt << ShiftForWord].
  			"So fmt is 3"
  			(self isContextHeader: header) ifTrue:
  				[coInterpreter setTraceFlagOnContextsFramesPageIfNeeded: oop.
  				 "contexts end at the stack pointer avoiding having to init fields beyond it"
  				 contextSize := coInterpreter fetchStackPointerOf: oop.
  				 self assert: ReceiverIndex + contextSize < (self lengthOf: oop baseHeader: header format: fmt).
  				 ^CtxtTempFrameStart + contextSize * BytesPerWord]].
  		 sz := self sizeBitsOfSafe: oop.
  		 ^sz - BaseHeaderSize  "all pointers" ].
  	fmt < 12 ifTrue: [^0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes"
  	^(coInterpreter literalCountOf: oop) * BytesPerWord + BaseHeaderSize!

Item was added:
+ ----- Method: NewObjectMemory>>longPrintReferencesTo: (in category 'debug printing') -----
+ longPrintReferencesTo: anOop
+ 	"Scan the heap long printing the oops of any and all objects that refer to anOop"
+ 	| oop i prntObj |
+ 	<api>
+ 	prntObj := false.
+ 	oop := self firstAccessibleObject.
+ 	[oop = nil] whileFalse:
+ 		[((self isPointers: oop) or: [self isCompiledMethod: oop]) ifTrue:
+ 			[(self isCompiledMethod: oop)
+ 				ifTrue:
+ 					[i := (self literalCountOf: oop) - 1]
+ 				ifFalse:
+ 					[(self isContext: oop)
+ 						ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
+ 						ifFalse: [i := (self lengthOf: oop) - 1]].
+ 			[i >= 0] whileTrue:
+ 				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
+ 					[self printHex: oop; print: ' @ '; printNum: i; cr.
+ 					 prntObj := true.
+ 					 i := 0].
+ 				 i := i - 1].
+ 			prntObj ifTrue:
+ 				[prntObj := false.
+ 				 coInterpreter longPrintOop: oop]].
+ 		 oop := self accessibleObjectAfter: oop]!

Item was changed:
  ----- Method: NewObjectMemory>>okayOop: (in category 'debug support') -----
  okayOop: signedOop
  	"Verify that the given oop is legitimate. Check address, header, and size but not class."
  
  	| sz type fmt unusedBit oop |
+ 	<var: #oop type: #usqInt>
+ 	oop := self cCoerce: signedOop to: #usqInt.
- 	<var: #oop type: 'usqInt'>
- 	oop := self cCoerce: signedOop to: 'usqInt'.
  
  	"address and size checks"
  	(self isIntegerObject: oop) ifTrue: [ ^true ].
+ 	(oop >= self startOfMemory and: [oop < freeStart])
- 	(oop < freeStart)
  		ifFalse: [ self error: 'oop is not a valid address'. ^false ].
  	((oop \\ BytesPerWord) = 0)
  		ifFalse: [ self error: 'oop is not a word-aligned address'. ^false ].
  	sz := self sizeBitsOf: oop.
+ 	(oop + sz) < freeStart
- 	(oop + sz) < endOfMemory
  		ifFalse: [ self error: 'oop size would make it extend beyond the end of memory'. ^false ].
  
  	"header type checks"
  	type := self headerType: oop.
  	type = HeaderTypeFree
  		ifTrue:  [ self error: 'oop is a free chunk, not an object'. ^false ].
  	type = HeaderTypeShort ifTrue: [
  		(self compactClassIndexOf: oop) = 0
  			ifTrue:  [ self error: 'cannot have zero compact class field in a short header'. ^false ].
  	].
  	type = HeaderTypeClass ifTrue: [
  		((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
  			ifFalse: [ self error: 'class header word has wrong type'. ^false ].
  	].
  	type = HeaderTypeSizeAndClass ifTrue: [
  		((oop >= (BytesPerWord*2)) and:
  		 [(self headerType: oop - (BytesPerWord*2)) = type and:
  		 [(self headerType: oop - BytesPerWord) = type]])
  			ifFalse: [ self error: 'class header word has wrong type'. ^false ].
  	].
  
  	"format check"
  	fmt := self formatOf: oop.
  	((fmt = 5) | (fmt = 7))
  		ifTrue:  [ self error: 'oop has an unknown format type'. ^false ].
  
  	"mark and root bit checks"
  	unusedBit := 16r20000000.
  	BytesPerWord = 8
  		ifTrue:
  			[unusedBit := unusedBit << 16.
  			 unusedBit := unusedBit << 16].
  	((self longAt: oop) bitAnd: unusedBit) = 0
  		ifFalse: [ self error: 'unused header bit 30 is set; should be zero'. ^false ].
  "xxx
  	((self longAt: oop) bitAnd: MarkBit) = 0
  		ifFalse: [ self error: 'mark bit should not be set except during GC' ].
  xxx"
  	(((self longAt: oop) bitAnd: RootBit) = 1 and:
  	 [oop >= youngStart])
  		ifTrue: [ self error: 'root bit is set in a young object'. ^false ].
  	^true
  !

Item was changed:
  ----- Method: ObjectMemory class>>initializeWithOptions: (in category 'initialization') -----
  initializeWithOptions: optionsDictionary
  	"ObjectMemory initializeWithOptions: Dictionary new"
  
+ 	self initBytesPerWord: (optionsDictionary at: #BytesPerWord ifAbsent: [4]).
+ 	BytesPerOop := optionsDictionary at: #BytesPerOop ifAbsent: [BytesPerWord].
- 	self initBytesPerWord: (optionsDictionary at: #BytesPerWord ifAbsent: [4])..
  
  	"Translation flags (booleans that control code generation via conditional translation):"
  	"generate assertion checks"
  	DoAssertionChecks := optionsDictionary at: #DoAssertionChecks ifAbsent: [false].
  	DoExpensiveAssertionChecks := optionsDictionary at: #DoExpensiveAssertionChecks ifAbsent: [false].
  
  	self initializeSpecialObjectIndices.
  	self initializeCompactClassIndices.
  	self initializePrimitiveErrorCodes.
  	self initializeObjectHeaderConstants.
  
  	NilContext := 1.  "the oop for the integer 0; used to mark the end of context lists"
  
  	RemapBufferSize := 25.
  	RootTableSize := 2500.  	"number of root table entries (4 bytes/entry)"
  	RootTableRedZone := RootTableSize - 100.	"red zone of root table - when reached we force IGC"
  	WeakRootTableSize := RootTableSize + RemapBufferSize + 100.
  
  	"tracer actions"
  	StartField := 1.
  	StartObj := 2.
  	Upward := 3.
  	Done := 4.
  
  	ExtraRootSize := 2048. "max. # of external roots"!

Item was added:
+ ----- Method: ObjectMemory>>checkOkayOop: (in category 'debug support') -----
+ checkOkayOop: oop
+ 	"Verify that the given oop is legitimate. Check address, header, and size but not class.
+ 	 Answer true if OK.  Otherwise print reason and answer false."
+ 
+ 	<api>
+ 	<var: #oop type: #usqInt>
+ 	| sz type fmt unusedBit |
+ 
+ 	"address and size checks"
+ 	(self isIntegerObject: oop) ifTrue: [ ^true ].
+ 	(oop >= self startOfMemory and: [oop < endOfMemory])
+ 		ifFalse: [ self print: 'oop is not a valid address'; cr. ^false ].
+ 	((oop \\ BytesPerWord) = 0)
+ 		ifFalse: [ self print: 'oop is not a word-aligned address'; cr. ^false ].
+ 	sz := self sizeBitsOf: oop.
+ 	(oop + sz) < endOfMemory
+ 		ifFalse: [ self print: 'oop size would make it extend beyond the end of memory'; cr. ^false ].
+ 
+ 	"header type checks"
+ 	type := self headerType: oop.
+ 	type = HeaderTypeFree
+ 		ifTrue:  [ self print: 'oop is a free chunk, not an object'; cr. ^false ].
+ 	type = HeaderTypeShort ifTrue: [
+ 		(self compactClassIndexOf: oop) = 0
+ 			ifTrue:  [ self print: 'cannot have zero compact class field in a short header'; cr. ^false ].
+ 	].
+ 	type = HeaderTypeClass ifTrue: [
+ 		((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
+ 			ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
+ 	].
+ 	type = HeaderTypeSizeAndClass ifTrue: [
+ 		((oop >= (BytesPerWord*2)) and:
+ 		 [(self headerType: oop - (BytesPerWord*2)) = type and:
+ 		 [(self headerType: oop - BytesPerWord) = type]])
+ 			ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
+ 	].
+ 
+ 	"format check"
+ 	fmt := self formatOf: oop.
+ 	((fmt = 5) | (fmt = 7))
+ 		ifTrue:  [ self print: 'oop has an unknown format type'; cr. ^false ].
+ 
+ 	"mark and root bit checks"
+ 	unusedBit := 16r20000000.
+ 	BytesPerWord = 8
+ 		ifTrue:
+ 			[unusedBit := unusedBit << 16.
+ 			 unusedBit := unusedBit << 16].
+ 	((self longAt: oop) bitAnd: unusedBit) = 0
+ 		ifFalse: [ self print: 'unused header bit 30 is set; should be zero'; cr. ^false ].
+ "xxx
+ 	((self longAt: oop) bitAnd: MarkBit) = 0
+ 		ifFalse: [ self print: 'mark bit should not be set except during GC' ].
+ xxx"
+ 	(((self longAt: oop) bitAnd: RootBit) = 1 and:
+ 	 [oop >= youngStart])
+ 		ifTrue: [ self print: 'root bit is set in a young object'; cr. ^false ].
+ 	^true
+ !

Item was changed:
  ----- Method: ObjectMemory>>fullGC (in category 'garbage collection') -----
  fullGC
  	"Do a mark/sweep garbage collection of the entire object memory. Free inaccessible objects but do not move them."
  
  	<inline: false>
  	DoAssertionChecks ifTrue:
  		[self reverseDisplayFrom: 0 to: 7.
  		 self clearLeakMapAndMapAccessibleObjects.
  		 self checkHeapIntegrity].
  	self preGCAction: GCModeFull.
  	gcStartUsecs := self ioUTCMicrosecondsNow.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
  	self clearRootsTable.
+ 	self initWeakTableForIncrementalGC: false.
  	youngStart := self startOfMemory.  "process all of memory"
  	self markPhase.
  	"Sweep phase returns the number of survivors.
  	Use the up-to-date version instead the one from startup."
  	totalObjectCount := self sweepPhase.
  	self fullCompaction.
  	allocationCount := 0.
  	statFullGCs := statFullGCs + 1.
  	statGCEndTime := self ioMicroMSecs.
  	statFullGCUsecs := statFullGCUsecs + (self ioUTCMicrosecondsNow - gcStartUsecs).
  	self capturePendingFinalizationSignals.
  
  	youngStart := freeBlock.  "reset the young object boundary"
  	self postGCAction.
  	DoAssertionChecks ifTrue:
  		[self clearLeakMapAndMapAccessibleObjects.
  		 self checkHeapIntegrity.
  		 self reverseDisplayFrom: 0 to: 7]!

Item was changed:
  ----- Method: ObjectMemory>>incrementalGC (in category 'garbage collection') -----
  incrementalGC
  	"Do a mark/sweep garbage collection of just the young object 
  	area of object memory (i.e., objects above youngStart), using 
  	the root table to identify objects containing pointers to 
  	young objects from the old object area."
  	| survivorCount weDidGrow |
  	<inline: false>
  	rootTableCount >= RootTableSize
  		ifTrue: ["root table overflow; cannot do an incremental GC (this should be very rare)"
  			statRootTableOverflows := statRootTableOverflows + 1.
  			^ self fullGC].
  
  	DoAssertionChecks ifTrue:
  		[self reverseDisplayFrom: 8 to: 15.
  		 self checkHeapIntegrity.
  		 self checkInterpreterIntegrity.
  		 self validate].
  
  	self preGCAction: GCModeIncr.
  	"incremental GC and compaction"
  
  	gcStartUsecs := self ioUTCMicrosecondsNow.
- 	weakRootCount := 0.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
+ 	self initWeakTableForIncrementalGC: true.
  	self markPhase.
  	self assert: weakRootCount <= WeakRootTableSize.
  	1 to: weakRootCount do:[:i| self finalizeReference: (weakRoots at: i)].
  	survivorCount := self sweepPhase.
  	self incrementalCompaction.
  	statAllocationCount := allocationCount.
  	allocationCount := 0.
  	statIncrGCs := statIncrGCs + 1.
  	statGCEndTime := self ioMicroMSecs.
  	statIGCDeltaUsecs := self ioUTCMicrosecondsNow - gcStartUsecs.
  	statIncrGCUsecs := statIncrGCUsecs + statIGCDeltaUsecs.
  	self capturePendingFinalizationSignals.
  
  	self forceInterruptCheck. "Force an an interrupt check ASAP.We could choose to be clever here and only do this under certain time conditions. Keep it simple for now"
  	
  	statRootTableCount  := rootTableCount.
  	statSurvivorCount := survivorCount.
  	weDidGrow := false.
  	(((survivorCount > tenuringThreshold)
  			or: [rootTableCount >= RootTableRedZone])
  			or: [forceTenureFlag == true])
  		ifTrue: ["move up the young space boundary if 
  			* there are too many survivors: 
  			this limits the number of objects that must be 
  			processed on future incremental GC's 
  			* we're about to overflow the roots table 
  			this limits the number of full GCs that may be caused 
  			by root table overflows in the near future"
  			forceTenureFlag := false.
  			statTenures := statTenures + 1.
  			self clearRootsTable.
  			(((self sizeOfFree: freeBlock) < growHeadroom) and: 
  				[gcBiasToGrow > 0]) 
  				ifTrue: [self biasToGrow.
  						weDidGrow := true].
  			youngStart := freeBlock].
  	self postGCAction.
  	DoAssertionChecks ifTrue:
  		[self validate.
  		 self checkHeapIntegrity.
  		 self checkInterpreterIntegrity.
  		 self reverseDisplayFrom: 8 to: 15].
  	weDidGrow ifTrue: [self biasToGrowCheckGCLimit]!

Item was added:
+ ----- Method: ObjectMemory>>initWeakTableForIncrementalGC: (in category 'gc -- mark and sweep') -----
+ initWeakTableForIncrementalGC: trueIfIncrementalGC
+ 	"The weakRoots table is only used for incrementalGC.
+ 	 Enable it by setting weakRootCount to 0.
+ 	 Disable it by making it negative."
+ 	weakRootCount := trueIfIncrementalGC ifTrue: [0] ifFalse: [-1]!

Item was changed:
  ----- Method: ObjectMemory>>okayOop: (in category 'debug support') -----
  okayOop: signedOop
  	"Verify that the given oop is legitimate. Check address, header, and size but not class."
  
  	| sz type fmt unusedBit oop |
+ 	<var: #oop type: #usqInt>
+ 	oop := self cCoerce: signedOop to: #usqInt.
- 	<var: #oop type: 'usqInt'>
- 	oop := self cCoerce: signedOop to: 'usqInt'.
  
  	"address and size checks"
  	(self isIntegerObject: oop) ifTrue: [ ^true ].
+ 	(oop >= self startOfMemory and: [oop < endOfMemory])
- 	(oop < endOfMemory)
  		ifFalse: [ self error: 'oop is not a valid address'. ^false ].
  	((oop \\ BytesPerWord) = 0)
  		ifFalse: [ self error: 'oop is not a word-aligned address'. ^false ].
  	sz := self sizeBitsOf: oop.
  	(oop + sz) < endOfMemory
  		ifFalse: [ self error: 'oop size would make it extend beyond the end of memory'. ^false ].
  
  	"header type checks"
  	type := self headerType: oop.
  	type = HeaderTypeFree
  		ifTrue:  [ self error: 'oop is a free chunk, not an object'. ^false ].
  	type = HeaderTypeShort ifTrue: [
  		(self compactClassIndexOf: oop) = 0
  			ifTrue:  [ self error: 'cannot have zero compact class field in a short header'. ^false ].
  	].
  	type = HeaderTypeClass ifTrue: [
  		((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
  			ifFalse: [ self error: 'class header word has wrong type'. ^false ].
  	].
  	type = HeaderTypeSizeAndClass ifTrue: [
  		((oop >= (BytesPerWord*2)) and:
  		 [(self headerType: oop - (BytesPerWord*2)) = type and:
  		 [(self headerType: oop - BytesPerWord) = type]])
  			ifFalse: [ self error: 'class header word has wrong type'. ^false ].
  	].
  
  	"format check"
  	fmt := self formatOf: oop.
  	((fmt = 5) | (fmt = 7))
  		ifTrue:  [ self error: 'oop has an unknown format type'. ^false ].
  
  	"mark and root bit checks"
  	unusedBit := 16r20000000.
  	BytesPerWord = 8
  		ifTrue:
  			[unusedBit := unusedBit << 16.
  			 unusedBit := unusedBit << 16].
  	((self longAt: oop) bitAnd: unusedBit) = 0
  		ifFalse: [ self error: 'unused header bit 30 is set; should be zero'. ^false ].
  "xxx
  	((self longAt: oop) bitAnd: MarkBit) = 0
  		ifFalse: [ self error: 'mark bit should not be set except during GC' ].
  xxx"
  	(((self longAt: oop) bitAnd: RootBit) = 1 and:
  	 [oop >= youngStart])
  		ifTrue: [ self error: 'root bit is set in a young object'. ^false ].
  	^true
  !

Item was changed:
+ ----- Method: ObjectMemory>>printInstancesOf: (in category 'debug printing') -----
- ----- Method: ObjectMemory>>printInstancesOf: (in category 'memory access') -----
  printInstancesOf: aClassOop
  	"Scan the heap printing the oops of any and all objects that are instances of aClassOop"
  	| oop |
  	<api>
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
  		[(self fetchClassOfNonInt: oop) = aClassOop ifTrue:
  			[self printHex: oop; cr].
  		 oop := self accessibleObjectAfter: oop]!

Item was changed:
+ ----- Method: ObjectMemory>>printMethodReferencesTo: (in category 'debug printing') -----
- ----- Method: ObjectMemory>>printMethodReferencesTo: (in category 'memory access') -----
  printMethodReferencesTo: anOop
  	"Scan the heap printing the oops of any and all objects that refer to anOop"
  	| oop i |
  	<api>
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
  		[(self isCompiledMethod: oop) ifTrue:
  			[i := (self literalCountOf: oop) - 1.
  			 [i >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
  					[self printHex: oop; print: ' @ '; printNum: i; cr.
  					 i := 0].
  				 i := i - 1]].
  		 oop := self accessibleObjectAfter: oop]!

Item was changed:
+ ----- Method: ObjectMemory>>printReferencesTo: (in category 'debug printing') -----
- ----- Method: ObjectMemory>>printReferencesTo: (in category 'memory access') -----
  printReferencesTo: anOop
  	"Scan the heap printing the oops of any and all objects that refer to anOop"
  	| oop i |
  	<api>
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
  		[((self isPointers: oop) or: [self isCompiledMethod: oop]) ifTrue:
  			[(self isCompiledMethod: oop)
  				ifTrue:
  					[i := (self literalCountOf: oop) - 1]
  				ifFalse:
  					[(self isContext: oop)
  						ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
  						ifFalse: [i := (self lengthOf: oop) - 1]].
  			[i >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
  					[self printHex: oop; print: ' @ '; printNum: i; cr.
  					 i := 0].
  				 i := i - 1]].
  		 oop := self accessibleObjectAfter: oop]!

Item was changed:
  ----- Method: ObjectMemory>>pushRemappableOop: (in category 'interpreter access') -----
  pushRemappableOop: oop
  	"Record the given object in a the remap buffer. Objects in this buffer are remapped when a compaction occurs. This facility is used by the interpreter to ensure that objects in temporary variables are properly remapped."
  	<api>
  	self assert: (self addressCouldBeOop: oop).
+ 	remapBuffer at: (remapBufferCount := remapBufferCount + 1) put: oop.
+ 	remapBufferCount <= RemapBufferSize ifFalse:
+ 		[self error: 'remapBuffer overflow'].!
- 	remapBuffer at: (remapBufferCount := remapBufferCount + 1) put: oop.!

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

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>genMustBeBooleanTrampolineFor:called: (in category 'initialization') -----
  genMustBeBooleanTrampolineFor: boolean called: trampolineName
+ 	"This can be entered in one of two states, depending on SendNumArgsReg. See
+ 	 e.g. genJumpIf:to:.  If SendNumArgsReg is non-zero then this has been entered via
+ 	 the initial test of the counter in the jump executed count (i.e. the counter has
+ 	 tripped).  In this case TempReg contains the boolean to be tested and should not
+ 	 be offset, and ceCounterTripped should be invoked with the unoffset TempReg.
+ 	 If SendNumArgsReg is zero then this has been entered for must-be-boolean
+ 	 processing. TempReg has been offset by boolean and must be corrected and
+ 	 ceSendMustBeBoolean: invoked with the corrected value."
- 	"THis can be entered in one of two states, depending on SendNumArgsReg.
- 	 If SendNumArgsReg is non-zero then this has been entered via the initial test of
- 	 the counted in the jump executed count.  In this case TempReg contains the
- 	 boolean to be tested and should not be offset, and ceCounterTripped should be
- 	 invoked with the unoffset TempReg.
- 	 If SendNumArgsReg is zero then this has been entered for must-be-boolean processing.
- 	 TempReg has been offset by boolean and must be corrected and ceSendMustBeBoolean:
- 	 invoked with the offset value."
  	<var: #trampolineName type: #'char *'>
  	| jumpMBB |
  	<var: #jumpMBB type: #'AbstractInstruction *'>
  	<inline: false>
  	opcodeIndex := 0.
  	self CmpCq: 0 R: SendNumArgsReg.
  	jumpMBB := self JumpZero: 0.
  	self compileTrampolineFor: #ceCounterTripped: asSymbol
  		callJumpBar: true
  		numArgs: 1
  		arg: TempReg
  		arg: nil
  		arg: nil
  		arg: nil
  		saveRegs: false
  		resultReg: nil.
  	"If the objectRepresentation does want true & false to be mobile then we need to record these addresses."
  	self assert: (objectRepresentation shouldAnnotateObjectReference: boolean) not.
  	jumpMBB jmpTarget: (self AddCq: boolean R: TempReg).
  	^self genTrampolineFor: #ceSendMustBeBoolean: asSymbol
  		called: trampolineName
  		callJumpBar: true
  		numArgs: 1
  		arg: TempReg
  		arg: nil
  		arg: nil
  		arg: nil
  		saveRegs: false
  		resultReg: nil
  		appendOpcodes: true!

Item was added:
+ ----- Method: StackInterpreter>>checkOopHasOkayClass: (in category 'debug support') -----
+ checkOopHasOkayClass: oop
+ 	"Attempt to verify that the given oop has a reasonable behavior. The class must be a valid, non-integer oop and must not be nilObj. It must be a pointers object with three or more fields. Finally, the instance specification field of the behavior must match that of the instance. If OK answer true.  If  not, print reason and answer false."
+ 
+ 	<api>
+ 	<var: #oop type: #usqInt>
+ 	| oopClass formatMask behaviorFormatBits oopFormatBits |
+ 	<var: #oopClass type: #usqInt>
+ 
+ 	(objectMemory checkOkayOop: oop) ifFalse:
+ 		[^false].
+ 	oopClass := self cCoerce: (objectMemory fetchClassOf: oop) to: #usqInt.
+ 
+ 	(objectMemory isIntegerObject: oopClass) ifTrue:
+ 		[self print: 'a SmallInteger is not a valid class or behavior'; cr. ^false].
+ 	(objectMemory okayOop: oopClass) ifFalse:
+ 		[self print: 'class oop is not ok'; cr. ^false].
+ 	((objectMemory isPointers: oopClass) and: [(objectMemory lengthOf: oopClass) >= 3]) ifFalse:
+ 		[self print: 'a class (behavior) must be a pointers object of size >= 3'; cr. ^false].
+ 	formatMask := (objectMemory isBytes: oop)
+ 						ifTrue: [16rC00]  "ignore extra bytes size bits"
+ 						ifFalse: [16rF00].
+ 
+ 	behaviorFormatBits := (objectMemory formatOfClass: oopClass) bitAnd: formatMask.
+ 	oopFormatBits := (objectMemory baseHeader: oop) bitAnd: formatMask.
+ 	behaviorFormatBits = oopFormatBits ifFalse:
+ 		[self print: 'object and its class (behavior) formats differ'; cr. ^false].
+ 	^true!

Item was changed:
  ----- Method: StackInterpreter>>findHomeForContext: (in category 'debug printing') -----
  findHomeForContext: aContext
  	| closureOrNil |
  	<inline: false>
+ 	(self isContext: aContext) ifFalse:
+ 		[^nil].
  	closureOrNil := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
  	closureOrNil = objectMemory nilObject ifTrue:
  		[^aContext].
+ 	(objectMemory fetchClassOf: closureOrNil) ~= (objectMemory splObj: ClassBlockClosure) ifTrue:
+ 		[^nil].
  	^self findHomeForContext: (objectMemory fetchPointer: ClosureOuterContextIndex ofObject: closureOrNil)!

Item was changed:
  ----- Method: StackInterpreter>>frameStackedReceiver:numArgs: (in category 'frame access') -----
  frameStackedReceiver: theFP numArgs: numArgs
  	"Answer the stacked receiver given the frame's argument count.
  	 The receiver of a message send or the closure of a block activation is
  	 always on the stack above any arguments and the frame itself.  See the
  	 diagram in StackInterpreter class>>initializeFrameIndices."
  	<inline: true>
  	<var: #theFP type: #'char *'>
+ 	^stackPages longAt: theFP + (self frameStackedReceiverOffsetNumArgs: numArgs)!
- 	^stackPages longAt: theFP + FoxCallerSavedIP + BytesPerWord + (numArgs << ShiftForWord)!

Item was changed:
  ----- Method: StackInterpreter>>frameStackedReceiverOffset: (in category 'frame access') -----
  frameStackedReceiverOffset: theFP
+ 	"Answer the offset in bytes from the the frame pointer to its stacked receiver.
- 	"Answer the offset in bytes from the a frame pointer to its stacked receiver.
  	 The receiver of a message send or the closure of a block activation is
  	 always on the stack above any arguments and the frame itself.  See the
  	 diagram in StackInterpreter class>>initializeFrameIndices."
  	<inline: true>
  	<var: #theFP type: #'char *'>
+ 	^self frameStackedReceiverOffsetNumArgs: (self frameNumArgs: theFP)!
- 	^FoxCallerSavedIP + BytesPerWord + ((self frameNumArgs: theFP) << ShiftForWord)!

Item was removed:
- ----- Method: StackInterpreter>>frameStackedReceiverOffset:numArgs: (in category 'frame access') -----
- frameStackedReceiverOffset: theFP numArgs: numArgs
- 	"Answer the offset in bytes from the a frame pointer to its stacked receiver.
- 	 The receiver of a message send or the closure of a block activation is
- 	 always on the stack above any arguments and the frame itself.  See the
- 	 diagram in StackInterpreter class>>initializeFrameIndices."
- 	<inline: true>
- 	<var: #theFP type: #'char *'>
- 	^FoxCallerSavedIP + BytesPerWord + (numArgs << ShiftForWord)!

Item was added:
+ ----- Method: StackInterpreter>>frameStackedReceiverOffsetNumArgs: (in category 'frame access') -----
+ frameStackedReceiverOffsetNumArgs: numArgs
+ 	"Answer the offset in bytes from the a frame pointer to its stacked receiver,
+ 	 given the argument count.  The receiver of a message send or the closure of
+ 	 a block activation is always on the stack above any arguments and the frame
+ 	 itself.  See the diagram in StackInterpreter class>>initializeFrameIndices."
+ 	<inline: true>
+ 	^FoxCallerSavedIP + BytesPerWord + (numArgs << ShiftForWord)!

Item was changed:
  ----- Method: StackInterpreter>>mapVMRegisters (in category 'object memory support') -----
  mapVMRegisters
  	"Map the oops in the interpreter's vm ``registers'' to their new values 
  	during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops."
  	instructionPointer := instructionPointer - method. "*rel to method"
+ 	method := (objectMemory remap: method).
- 	self setMethod: (objectMemory remap: method).
  	instructionPointer := instructionPointer + method. "*rel to method"
  	(objectMemory isIntegerObject: messageSelector) ifFalse:
  		[messageSelector := objectMemory remap: messageSelector].
  	(objectMemory isIntegerObject: newMethod) ifFalse:
  		[newMethod := objectMemory remap: newMethod].
  	lkupClass := objectMemory remap: lkupClass!

Item was changed:
  ----- Method: StackInterpreter>>markContextAsDead: (in category 'frame access') -----
  markContextAsDead: oop
  	"Mark the argument, which must be a context, married, widowed or single, as dead.
  	 For married or widowed contexts this breaks any link to the spouse and makes the context single.
+ 	 For all contexts, marks the context as inactive/having been returned from."
- 	 For all contexts, marks the comtext as inactive/having been returned from."
  	<inline: true>
  	self assert: (self isContext: oop).
  	objectMemory
  		storePointerUnchecked: SenderIndex ofObject: oop withValue: objectMemory nilObject;
  		storePointerUnchecked: InstructionPointerIndex ofObject: oop withValue: objectMemory nilObject!

Item was changed:
  ----- Method: StackInterpreter>>printFrameAndCallers:SP: (in category 'debug printing') -----
  printFrameAndCallers: theFP SP: theSP
+ 	self printFrameAndCallers: theFP SP: theSP short: false!
- 	<inline: false>
- 	<var: #theFP type: #'char *'>
- 	<var: #theSP type: #'char *'>
- 	(stackPages couldBeFramePointer: theFP) ifFalse: [^nil].
- 	(self isBaseFrame: theFP) ifFalse:
- 		[self printFrameAndCallers: (self frameCallerFP: theFP)
- 			SP: (self frameCallerSP: theFP)].
- 	self cr.
- 	self printFrame: theFP WithSP: theSP!

Item was added:
+ ----- Method: StackInterpreter>>printFrameAndCallers:SP:short: (in category 'debug printing') -----
+ printFrameAndCallers: theFP SP: theSP short: printShort
+ 	<inline: false>
+ 	<var: #theFP type: #'char *'>
+ 	<var: #theSP type: #'char *'>
+ 	(stackPages couldBeFramePointer: theFP) ifFalse: [^nil].
+ 	(self isBaseFrame: theFP) ifFalse:
+ 		[self printFrameAndCallers: (self frameCallerFP: theFP)
+ 			SP: (self frameCallerSP: theFP)
+ 			short: printShort].
+ 	self cr.
+ 	printShort
+ 		ifTrue: [self shortPrintFrame: theFP]
+ 		ifFalse: [self printFrame: theFP WithSP: theSP]!

Item was changed:
  ----- Method: StackInterpreter>>printFramesInPage: (in category 'debug printing') -----
  printFramesInPage: thePage
+ 	<export: true> "use export: not api, so it won't be written to cointerp.h. cogit.c is unaware of StackPage"
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
+ 	self printFrameAndCallers: thePage headFP SP: thePage headSP short: false!
- 	self printFrameAndCallers: thePage headFP SP: thePage headSP!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintContext: (in category 'debug printing') -----
  shortPrintContext: aContext
+ 	| theFP |
- 	| home theFP |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	(self isContext: aContext) ifFalse:
  		[self printHex: aContext; print: ' is not a context'; cr.
  		^nil].
- 	home := self findHomeForContext: aContext.
  	self printHex: aContext.
  	(self isMarriedOrWidowedContext: aContext)
  		ifTrue: [(self checkIsStillMarriedContext: aContext currentFP: framePointer)
  					ifTrue:
  						[(self isMachineCodeFrame: (theFP := self frameOfMarriedContext: aContext))
  							ifTrue: [self print: ' M (']
  							ifFalse: [self print: ' I ('].
  						 self printHex: theFP; print: ') ']
  					ifFalse:
  						[self print: ' w ']]
  		ifFalse: [self print: ' s '].
+ 	(self findHomeForContext: aContext)
+ 		ifNil: [self print: ' BOGUS CONTEXT (can''t determine home)']
+ 		ifNotNil:
+ 			[:home|
+ 			self printActivationNameFor: (objectMemory fetchPointer: MethodIndex ofObject: aContext)
+ 		receiver: (home isNil
+ 					ifTrue: [objectMemory nilObject]
+ 					ifFalse: [objectMemory fetchPointer: ReceiverIndex ofObject: home])
- 	self printActivationNameFor: (objectMemory fetchPointer: MethodIndex ofObject: home)
- 		receiver: (objectMemory fetchPointer: ReceiverIndex ofObject: home)
  		isBlock: home ~= aContext
+ 		firstTemporary: (objectMemory fetchPointer: 0 + CtxtTempFrameStart ofObject: home)].
- 		firstTemporary: (objectMemory fetchPointer: 0 + CtxtTempFrameStart ofObject: home).
  	self cr!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintFramesInPage: (in category 'debug printing') -----
  shortPrintFramesInPage: thePage
+ 	<export: true> "use export: not api, so it won't be written to cointerp.h. cogit.c is unaware of StackPage"
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
+ 	self printFrameAndCallers: thePage headFP SP: thePage headSP short: true!
- 	self shortPrintFrameAndCallers: thePage headFP!

Item was changed:
  ----- Method: StackInterpreter>>updateStateOfSpouseContextForFrame:WithSP: (in category 'frame access') -----
  updateStateOfSpouseContextForFrame: theFP WithSP: theSP
  	"Update the frame's spouse context with the frame's current state except for the
  	 sender and instruction pointer, which are used to mark the context as married."
  	| theContext tempIndex pointer |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	<var: #pointer type: #'char *'>
+ 	<var: #argsPointer type: #'char *'>
  	self assert: (self frameHasContext: theFP).
  	theContext := self frameContext: theFP.
  	self assert: (self frameReceiver: theFP)
  				= (objectMemory fetchPointer: ReceiverIndex ofObject: theContext).
  	tempIndex := self frameNumArgs: theFP.
+ 	"update the arguments. this would appear not to be strictly necessary, but is for two reasons.
+ 	 First, the fact that arguments are read-only is only as convention in the Smalltalk compiler;
+ 	 other languages may choose to modify arguments.
+ 	 Second, the Squeak runUntilErrorOrReturnFrom: nightmare pops the stack top, which may, in
+ 	 certain circumstances, be the last argument, and hence the last argument may not have been
+ 	 stored into the context."
+ 	pointer := theFP + (self frameStackedReceiverOffsetNumArgs: tempIndex).
+ 	1 to: tempIndex do:
+ 		[:i|
+ 		pointer := pointer - BytesPerWord.
+ 		self assert: (objectMemory addressCouldBeOop: (stackPages longAt: pointer)).
+ 		 objectMemory storePointer: ReceiverIndex + i
+ 			ofObject: theContext
+ 			withValue: (stackPages longAt: pointer)].
+ 	"now update the non-argument stack contents."
  	pointer := theFP + FoxReceiver - BytesPerWord.
  	[pointer >= theSP] whileTrue:
  		[self assert: (objectMemory addressCouldBeOop: (stackPages longAt: pointer)).
  		 tempIndex := tempIndex + 1.
  		 objectMemory storePointer: ReceiverIndex + tempIndex
  			ofObject: theContext
  			withValue: (stackPages longAt: pointer).
  		 pointer := pointer - BytesPerWord].
  	self assert: ReceiverIndex + tempIndex < (objectMemory lengthOf: theContext).
  	objectMemory storePointerUnchecked: StackPointerIndex
  		ofObject: theContext
  		withValue: (objectMemory integerObjectOf: tempIndex)!

Item was removed:
- ----- Method: StackInterpreterSimulator>>printCurrPageFrames (in category 'debug printing') -----
- printCurrPageFrames
- 	self printFrameAndCallers: localFP SP: localSP!

Item was added:
+ ----- Method: VMMaker class>>generateConfiguration (in category 'configurations') -----
+ generateConfiguration
+ 	"VMMaker generateConfiguration"
+ 	| configCategoryName selectors |
+ 	configCategoryName := self class whichCategoryIncludesSelector: thisContext selector.
+ 	selectors := Set new.
+ 	self class organization categories do:
+ 		[:cat|
+ 		(cat endsWith: configCategoryName) ifTrue:
+ 			[selectors addAll: (self class organization listAtCategoryNamed: cat)]].
+ 	selectors remove: thisContext selector.
+ 	selectors := selectors asArray sort.
+ 	(UIManager default
+ 			chooseFrom: (selectors collect:
+ 							[:sel| (sel piecesCutWhere: [:a :b| a isLowercase and: [b isUppercase]]) allButFirst
+ 									fold: [:a :b| a, ' ', b]])
+ 			values: selectors) ifNotNil:
+ 		[:choice|
+ 		self perform: choice]!

Item was added:
+ ----- Method: VMMaker class>>generateNewspeakCogVM (in category 'configurations') -----
+ generateNewspeakCogVM
+ 	^VMMaker
+ 		generate: CoInterpreter
+ 		and: StackToRegisterMappingCogit"Cogit chooseCogitClass"
+ 		with: #(NewspeakVM true)
+ 		to: (FileDirectory default pathFromURI: 'oscogvm/nscogsrc')
+ 		platformDir: (FileDirectory default pathFromURI: '../Newspeak/newclosurevm/platforms')
+ 		including:#(	AsynchFilePlugin BMPReadWriterPlugin BalloonEnginePlugin BitBltSimulation DSAPlugin DropPlugin
+ 					FileCopyPlugin FilePlugin FloatArrayPlugin FloatMathPlugin InflatePlugin JPEGReadWriter2Plugin
+ 					JPEGReaderPlugin LargeIntegersPlugin Matrix2x3Plugin MiscPrimitivePlugin NewsqueakIA32ABIPlugin
+ 					RePlugin SecurityPlugin SocketPlugin SoundPlugin SurfacePlugin ThreadedIA32FFIPlugin
+ 					UUIDPlugin UnixOSProcessPlugin VMProfileMacSupportPlugin Win32OSProcessPlugin)!

Item was added:
+ ----- Method: VMMaker class>>generateNewspeakInterpreterVM (in category 'configurations') -----
+ generateNewspeakInterpreterVM
+ 	^VMMaker
+ 		generate: NewspeakInterpreter
+ 		to: (FileDirectory default pathFromURI: 'oscogvm/nssrc')
+ 		platformDir: (FileDirectory default pathFromURI: '../Newspeak/newclosurevm/platforms')
+ 		including:#(	AsynchFilePlugin BMPReadWriterPlugin BalloonEnginePlugin BitBltSimulation DSAPlugin DropPlugin
+ 					FileCopyPlugin FilePlugin FloatArrayPlugin FloatMathPlugin InflatePlugin JPEGReadWriter2Plugin
+ 					JPEGReaderPlugin LargeIntegersPlugin Matrix2x3Plugin MiscPrimitivePlugin NewsqueakIA32ABIPlugin
+ 					RePlugin SecurityPlugin SocketPlugin SoundPlugin SurfacePlugin UUIDPlugin UnixOSProcessPlugin
+ 					VMProfileMacSupportPlugin Win32OSProcessPlugin)!

Item was added:
+ ----- Method: VMMaker class>>generateNewspeakStackVM (in category 'configurations') -----
+ generateNewspeakStackVM
+ 	^VMMaker
+ 		generate: StackInterpreter
+ 		with: #(NewspeakVM true)
+ 		to: (FileDirectory default pathFromURI: 'oscogvm/nsstacksrc')
+ 		platformDir: (FileDirectory default pathFromURI: '../Newspeak/newclosurevm/platforms')
+ 		including:#(	AsynchFilePlugin BMPReadWriterPlugin BalloonEnginePlugin BitBltSimulation DSAPlugin DropPlugin
+ 					FileCopyPlugin FilePlugin FloatArrayPlugin FloatMathPlugin InflatePlugin JPEGReadWriter2Plugin
+ 					JPEGReaderPlugin LargeIntegersPlugin Matrix2x3Plugin MiscPrimitivePlugin NewsqueakIA32ABIPlugin
+ 					RePlugin SecurityPlugin SocketPlugin SoundPlugin SurfacePlugin UUIDPlugin UnixOSProcessPlugin
+ 					VMProfileMacSupportPlugin Win32OSProcessPlugin)!

Item was added:
+ ----- Method: VMMaker class>>generateSqueakCogSistaVM (in category 'configurations') -----
+ generateSqueakCogSistaVM
+ 	^VMMaker
+ 		generate: (Smalltalk at: ([:choices| choices at: (UIManager default chooseFrom: choices) ifAbsent: [^self]]
+ 									value: #(CoInterpreter CoInterpreterMT)))
+ 		and: SistaStackToRegisterMappingCogit
+ 		to: (FileDirectory default pathFromURI: 'cogvm/sistasrc')
+ 		platformDir: (FileDirectory default pathFromURI: 'cogvm/platforms')
+ 		excluding:#(BrokenPlugin DShowVideoDecoderPlugin NewsqueakIA32ABIPlugin NewsqueakIA32ABIPluginAttic
+ 					CroquetPlugin HostWindowPlugin SoundPlugin
+ 					QuicktimePlugin QVideoCodecPlugin QwaqMediaPlugin SlangTestPlugin TestOSAPlugin
+ 					FFIPlugin ThreadedARMFFIPlugin ThreadedFFIPlugin ThreadedPPCBEFFIPlugin
+ 					ReentrantARMFFIPlugin ReentrantFFIPlugin ReentrantIA32FFIPlugin ReentrantPPCBEFFIPlugin)!

Item was added:
+ ----- Method: VMMaker class>>generateSqueakCogVM (in category 'configurations') -----
+ generateSqueakCogVM
+ 	^VMMaker
+ 		generate: (Smalltalk at: ([:choices| choices at: (UIManager default chooseFrom: choices) ifAbsent: [^self]]
+ 									value: #(CoInterpreter CoInterpreterMT)))
+ 		and: StackToRegisterMappingCogit
+ 		to: (FileDirectory default pathFromURI: 'oscogvm/src')
+ 		platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms')
+ 		including:#(	ADPCMCodecPlugin AsynchFilePlugin BalloonEnginePlugin B3DAcceleratorPlugin
+ 					BMPReadWriterPlugin BitBltSimulation BochsIA32Plugin CroquetPlugin DSAPlugin
+ 					DeflatePlugin DropPlugin FT2Plugin FFTPlugin FileCopyPlugin FilePlugin FloatArrayPlugin
+ 					FloatMathPlugin GeniePlugin HostWindowPlugin IA32ABIPlugin InternetConfigPlugin
+ 					JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin
+ 					LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin
+ 					MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin SecurityPlugin SerialPlugin
+ 					SocketPlugin SoundCodecPlugin SoundGenerationPlugin SoundPlugin ThreadedIA32FFIPlugin
+ 					StarSqueakPlugin UUIDPlugin UnixOSProcessPlugin Win32OSProcessPlugin VMProfileMacSupportPlugin)!

Item was added:
+ ----- Method: VMMaker class>>generateSqueakStackVM (in category 'configurations') -----
+ generateSqueakStackVM
+ 	"No primitives since we can use those for the Cog VM"
+ 	^VMMaker
+ 		generate: StackInterpreter
+ 		to: (FileDirectory default pathFromURI: 'oscogvm/stacksrc')
+ 		platformDir: (FileDirectory default pathFromURI: 'cogvm/platforms')
+ 		excluding: (InterpreterPlugin withAllSubclasses collect: [:ea| ea name])!



More information about the Vm-dev mailing list