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

commits at source.squeak.org commits at source.squeak.org
Wed Nov 5 00:53:45 UTC 2014


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

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

Name: VMMaker.oscog-eem.923
Author: eem
Time: 4 November 2014, 4:45:37.508 pm
UUID: b4a88a08-47d9-4173-9d8d-a2c11886c5fb
Ancestors: VMMaker.oscog-eem.918

Back out of Ryan's recent absent receiver changes,
while accumulating the other recent fixes.  There's
some incompatibility with the working classes
machinery at Cadence and Ryan's recent changes
which we don't have time to resolve right now.

The kept changes are:
Fix asserts in addFreeSubTree: & addToFreeTree:bytes:.

Fix possible forwarding of the receiver in implicit
receiver sends.

Eliminate some compiler warnings in the refactored
instVar:ofContext: changes.

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

Item was changed:
  ----- Method: CoInterpreter>>instVar:ofContext: (in category 'frame access') -----
  instVar: offset ofContext: aContext
  	"Fetch an instance avriable from a maybe married context.
  	 If the context is still married compute the value of the
  	 relevant inst var from the spouse frame's state.
  
  	 If the context is single but has a negative instruction pointer
  	 recognise that the instruction pointer is actually into machine
  	 code and convert it to the corresponding bytecode pc."
  	| value spouseFP |
  	<var: #spouseFP type: #'char *'>
  	<inline: true>
  	self assert: offset < MethodIndex.
  	self assert: (objectMemory isContext: aContext).
  	self writeBackHeadFramePointers.
  	(self isMarriedOrWidowedContext: aContext) ifFalse:
  		[value := objectMemory fetchPointer: offset ofObject: aContext.
  		 (offset = InstructionPointerIndex
  		  and: [(objectMemory isIntegerObject: value)
  		  and: [value signedIntFromLong < 0]]) ifTrue:
  			[value := self internalMustMapMachineCodePC: (objectMemory integerValueOf: value)
  						context: aContext].
  		 ^value].
  
  	(self isWidowedContext: aContext) ifTrue:
  		[^objectMemory fetchPointer: offset ofObject: aContext].
  
  	spouseFP := self frameOfMarriedContext: aContext.
  	offset = SenderIndex ifTrue:
  		[^self ensureCallerContext: spouseFP].
  	offset = StackPointerIndex ifTrue:
  		[self assert: ReceiverIndex + (self stackPointerIndexForFrame: spouseFP) < (objectMemory lengthOf: aContext).
  		^objectMemory integerObjectOf: (self stackPointerIndexForFrame: spouseFP)].
  	offset = InstructionPointerIndex ifTrue:
+ 		[^self instructionPointerForFrame: spouseFP currentFP: localFP currentIP: (self oopForPointer: localIP)].
- 		[^self instructionPointerForFrame: spouseFP currentFP: localFP currentIP: localIP].
  	self error: 'bad index'.
  	^0!

Item was changed:
  ----- Method: CoInterpreter>>instructionPointerForFrame:currentFP:currentIP: (in category 'frame access') -----
  instructionPointerForFrame: spouseFP currentFP: currentFP currentIP: instrPtr
  	"Answer the bytecode pc object (i.e. SmallInteger) for an active frame.  The bytecode
  	 pc is derived from the frame's pc.  If the frame is the top frame on the current stack
  	 the frame pc is whatever the current instruction pointer is.  If the frame is the top
  	 frame on some other stack the frame pc is the value on top of stack.  Otherwise the
  	 frame pc is the saved pc of the frame above.  Once the frame pc is found it must be
  	 mapped to a bytecode pc."
+ 	<var: #spouseFP type: #'char *'>
+ 	<var: #currentFP type: #'char *'>
  	| value theIP thePage theFPAbove |
+ 	<var: #thePage type: #'StackPage *'>
+ 	<var: #theFPAbove type: #'char *'>
  	spouseFP = currentFP
  		ifTrue: [theIP := self oopForPointer: instrPtr]
  		ifFalse:
  			[thePage := stackPages stackPageFor: spouseFP.
  			 theFPAbove := self findFrameAbove: spouseFP inPage: thePage.
  			 theIP := theFPAbove == 0
  						ifTrue: [stackPages longAt: thePage headSP]
  						ifFalse:[self oopForPointer: (self frameCallerSavedIP: theFPAbove)]].
  	value := self contextInstructionPointer: theIP frame: spouseFP.
  	^value signedIntFromLong < 0
  		ifTrue: [self mustMapMachineCodePC: (objectMemory integerValueOf: value)
  					context: (self frameContext: spouseFP)]
  		ifFalse: [value]!

Item was added:
+ ----- Method: CoInterpreter>>internalFollowedReceiver (in category 'internal interpreter access') -----
+ internalFollowedReceiver
+ 	<inline: true>
+ 	| rcvr |
+ 	rcvr := stackPages longAt: localFP + FoxIFReceiver.
+ 	(objectMemory isOopForwarded: rcvr) ifTrue:
+ 		[rcvr := objectMemory followForwarded: rcvr.
+ 		 stackPages longAt: localFP + FoxIFReceiver put: rcvr].
+ 	^rcvr!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genEnsureObjInRegNotForwarded:scratchReg:updatingMw:r: (in category 'compile abstract instructions') -----
+ genEnsureObjInRegNotForwarded: reg scratchReg: scratch updatingMw: offset r: baseReg
+ 	"Make sure that the object in reg is not forwarded, and update the field reg[offset] is
+ 	 updated if the object in reg is forwarded.
+ 	 Use the fact that isForwardedObjectClassIndexPun is a power of two to save an instruction."
+ 	| loop imm ok |
+ 	<var: #ok type: #'AbstractInstruction *'>
+ 	<var: #imm type: #'AbstractInstruction *'>
+ 	<var: #loop type: #'AbstractInstruction *'>
+ 	self assert: reg ~= scratch.
+ 	loop := cogit Label.
+ 	cogit MoveR: reg R: scratch.
+ 	imm := self genJumpImmediateInScratchReg: scratch.
+ 	"notionally
+ 		self genGetClassIndexOfNonImm: reg into: scratch.
+ 		cogit CmpCq: objectMemory isForwardedObjectClassIndexPun R: TempReg.
+ 	 but the following is an instruction shorter:"
+ 	cogit MoveMw: 0 r: reg R: scratch.
+ 	cogit
+ 		AndCq: objectMemory classIndexMask - objectMemory isForwardedObjectClassIndexPun
+ 		R: scratch.
+ 	ok := cogit JumpNonZero:  0.
+ 	self genLoadSlot: 0 sourceReg: reg destReg: reg.
+ 	cogit MoveR: reg Mw: offset r: baseReg.
+ 	cogit Jump: loop.
+ 	ok jmpTarget: (imm jmpTarget: cogit Label).
+ 	^0!

Item was changed:
  ----- Method: Cogit>>generateNewspeakRuntime (in category 'initialization') -----
  generateNewspeakRuntime
  	<option: #NewspeakVM>
  	| jumpMiss jumpItsTheReceiverStupid retpcReg |
  	<var: #jumpMiss type: #'AbstractInstruction *'>
  	<var: #jumpItsTheReceiverStupid type: #'AbstractInstruction *'>
  	"Generate the non-send runtime support for Newspeak, explicit outer and implicit receiver.
  	 The dynamic frequency of explicit outer is so low we merely call an interpreter routine."
  	ceEnclosingObjectTrampoline := self genTrampolineFor: #ceEnclosingObjectAt:
  										called: 'ceEnclosingObjectTrampoline'
  										arg: SendNumArgsReg
  										result: ReceiverResultReg.
  	"Cached push implicit receiver implementation.  If objectRepresentation doesn't support
  	 pinning then caller looks like
  				mov selector, SendNumArgsReg
  				call ceImplicitReceiver
  				br continue
  		Lclass:	.word
  		Lmixin::	.word
  		continue:
  	 If objectRepresentation supports pinning then caller looks like
  				mov Lclass, Arg1Reg
  				mov selector, SendNumArgsReg
  				call ceImplicitReceiver
  	 and Lclass: .word; Lmixin: .word is somewhere on the heap.
  
  	 If class tag matches class of receiver then mixin contains either 0 or the implicit receiver.
  	 If 0, answer the actual receiver, otherwise the mixin.
  	 Generate the class fetch and cache probe inline for speed.
  	 Smashes Arg1Reg, RegClass and caller-saved regs."
  	opcodeIndex := 0.
  	self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
  	objectRepresentation
  		genGetInlineCacheClassTagFrom: ReceiverResultReg
  		into: ClassReg
  		forEntry: false.
  	objectRepresentation canPinObjects
  		ifTrue:
  			[self MoveMw: 0 r: Arg1Reg R: TempReg.
  			 self CmpR: ClassReg R: TempReg.
  			 jumpMiss := self JumpNonZero: 0.
  			 self MoveMw: BytesPerOop r: Arg1Reg R: TempReg.
  			 self CmpCq: 0 R: TempReg.
  			 jumpItsTheReceiverStupid := self JumpZero: 0.
  			 self MoveR: TempReg R: ReceiverResultReg.
  			 jumpItsTheReceiverStupid jmpTarget: (self RetN: 0).
  			 jumpMiss jmpTarget: self Label.
+ 			 objectRepresentation
+ 				genEnsureObjInRegNotForwarded: ReceiverResultReg
+ 				scratchReg: TempReg
+ 				updatingMw: FoxMFReceiver
+ 				r: FPReg.
  			 ceImplicitReceiverTrampoline := self
  												genTrampolineFor: #ceImplicitReceiverFor:receiver:cache:
  												called: 'ceImplicitReceiverTrampoline'
  												numArgs: 3
  												arg: SendNumArgsReg
  												arg: ReceiverResultReg
  												arg: Arg1Reg
  												arg: nil
  												saveRegs: false
  												pushLinkReg: true
  												resultReg: ReceiverResultReg
  												appendOpcodes: true]
  		ifFalse:
  			[backEnd hasLinkRegister
  				ifTrue: [retpcReg := LinkReg]
  				ifFalse: [self MoveMw: 0 r: SPReg R: (retpcReg := TempReg)].
  			 self MoveMw: 0 r: SPReg R: retpcReg.
  			 self MoveMw: backEnd jumpShortByteSize r: retpcReg R: Arg1Reg.
  			 self CmpR: ClassReg R: Arg1Reg.
  			 jumpMiss := self JumpNonZero: 0.
  			 self MoveMw: backEnd jumpShortByteSize + BytesPerOop r: retpcReg R: ClassReg.
  			 self CmpCq: 0 R: ClassReg.
  			 jumpItsTheReceiverStupid := self JumpZero: 0.
  			 self MoveR: ClassReg R: ReceiverResultReg.
  			 jumpItsTheReceiverStupid jmpTarget: (self RetN: 0).
  			 jumpMiss jmpTarget: self Label.
  			 ceImplicitReceiverTrampoline := self
  												genTrampolineFor: #ceImplicitReceiverFor:receiver:
  												called: 'ceImplicitReceiverTrampoline'
  												numArgs: 2
  												arg: SendNumArgsReg
  												arg: ReceiverResultReg
  												arg: nil
  												arg: nil
  												saveRegs: false
  												pushLinkReg: true
  												resultReg: ReceiverResultReg
  												appendOpcodes: true]!

Item was changed:
  ----- Method: SpurMemoryManager>>addFreeSubTree: (in category 'free space') -----
  addFreeSubTree: freeTree
  	"Add a freeChunk sub tree back into the large free chunk tree.
  	 This is for allocateOldSpaceChunkOf[Exactly]Bytes:[suchThat:]."
  	| bytesInArg treeNode bytesInNode subNode |
  	"N.B. *can't* use numSlotsOfAny: because of rounding up of odd slots
  	 and/or step in size at 1032 bytes in 32-bits or 2048 bytes in 64-bits."
  	self assert: (self isFreeObject: freeTree).
  	bytesInArg := self bytesInObject: freeTree.
  	self assert: bytesInArg >= (self numFreeLists * self allocationUnit).
  	treeNode := freeLists at: 0.
  	self assert: treeNode ~= 0.
  	[bytesInNode := self bytesInObject: treeNode.
+ 	 "check for overlap; could write this as self oop: (self objectAfter: freeChunk) isLessThanOrEqualTo: child...
+ 	  but that relies on headers being correct, etc.  So keep it clumsy..."
+ 	 self assert: ((self oop: freeTree + bytesInArg - self baseHeaderSize isLessThanOrEqualTo: treeNode)
+ 					or: [self oop: freeTree isGreaterThanOrEqualTo: treeNode + bytesInNode - self baseHeaderSize]).
- 	 self assert: ((self oop: freeTree + bytesInArg isLessThanOrEqualTo: treeNode)
- 					or: [self oop: freeTree isGreaterThanOrEqualTo: treeNode + bytesInNode]).
  	 self assert: bytesInNode >= (self numFreeLists * self allocationUnit).
  	 self assert: bytesInArg ~= bytesInNode.
  	 bytesInNode > bytesInArg
  		ifTrue:
  			[subNode := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode.
  			 subNode = 0 ifTrue:
  				[self storePointer: self freeChunkSmallerIndex ofFreeChunk: treeNode withValue: freeTree.
  				 self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode.
  				 ^self]]
  		ifFalse:
  			[subNode := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode.
  			 subNode = 0 ifTrue:
  				[self storePointer: self freeChunkLargerIndex ofFreeChunk: treeNode withValue: freeTree.
  				 self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode.
  				 ^self]].
  	 treeNode := subNode] repeat!

Item was changed:
  ----- Method: SpurMemoryManager>>addToFreeTree:bytes: (in category 'free space') -----
  addToFreeTree: freeChunk bytes: chunkBytes
  	"Add freeChunk to the large free chunk tree.
  	 For the benefit of sortedFreeObject:, answer the treeNode it is added
  	 to, if it is added to the next list of a freeTreeNode, otherwise answer 0."
  	| childBytes parent child |
  	self assert: (self isFreeObject: freeChunk).
  	self assert: chunkBytes = (self bytesInObject: freeChunk).
  	self assert: chunkBytes >= (self numFreeLists * self allocationUnit).
  	self
  		storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0;
  		storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0;
  		storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0;
  		storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0.
  	"Large chunk list organized as a tree, each node of which is a list of chunks of the same size.
  	 Beneath the node are smaller and larger blocks."
  	parent := 0.
  	child := freeLists at: 0.
  	[child ~= 0] whileTrue:
  		[childBytes := self bytesInObject: child.
+ 		 "check for overlap; could write this as self oop: (self objectAfter: freeChunk) isLessThanOrEqualTo: child...
+ 		  but that relies on headers being correct, etc.  So keep it clumsy..."
+ 		 self assert: ((self oop: freeChunk + chunkBytes - self baseHeaderSize isLessThanOrEqualTo: child)
+ 						or: [self oop: freeChunk isGreaterThanOrEqualTo: child + childBytes - self baseHeaderSize]).
- 		 self assert: ((self oop: freeChunk + chunkBytes isLessThanOrEqualTo: child)
- 						or: [self oop: freeChunk isGreaterThanOrEqualTo: child + childBytes]).
  		 childBytes = chunkBytes ifTrue: "size match; add to list at node."
  			[self storePointer: self freeChunkNextIndex
  					ofFreeChunk: freeChunk
  						withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: child);
  				storePointer: self freeChunkNextIndex
  					ofFreeChunk: child
  						withValue: freeChunk.
  			 ^child].
  		 "walk down the tree"
  		 parent := child.
  		 child := self fetchPointer: (childBytes > chunkBytes
  										ifTrue: [self freeChunkSmallerIndex]
  										ifFalse: [self freeChunkLargerIndex])
  					ofFreeChunk: child].
  	parent = 0 ifTrue:
  		[self assert: (freeLists at: 0) = 0.
  		 freeLists at: 0 put: freeChunk.
  		 freeListsMask := freeListsMask bitOr: 1.
  		 ^0].
  	self assert: (freeListsMask anyMask: 1).
  	"insert in tree"
  	self storePointer: self freeChunkParentIndex
  			ofFreeChunk: freeChunk
  				withValue: parent.
  	self storePointer: (childBytes > chunkBytes
  									ifTrue: [self freeChunkSmallerIndex]
  									ifFalse: [self freeChunkLargerIndex])
  			ofFreeChunk: parent
  				withValue: freeChunk.
  	^0!

Item was changed:
  ----- Method: StackInterpreter>>commonSendAbsentImplicit (in category 'send bytecodes') -----
  commonSendAbsentImplicit
  	"Send a message to the implicit receiver for that message."
  	"Assume: messageSelector and argumentCount have been set, and that 
  	the arguments but not the receiver have been pushed onto the stack,"
  	"Note: This method is inlined into the interpreter dispatch loop."
  	"160-175	1010 i i i i		Send To Absent Implicit Receiver Literal Selector #iiii With 0 Arguments"
  	"240		11110000	i i i i i j j j	Send To Absent Implicit Receiver Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
  	<sharedCodeInCase: #extSendAbsentImplicitBytecode>
+ 	| followedReceiver implicitReceiver |
+ 	followedReceiver := self internalFollowedReceiver.
- 	| implicitReceiver |
  	implicitReceiver := self
+ 							implicitReceiverFor: followedReceiver
- 							implicitReceiverFor: self receiver
  							mixin: (self methodClassOf: method)
  							implementing: messageSelector.
  	self shuffleArgumentsAndStoreAbsentReceiver: implicitReceiver.
  	lkupClassTag := objectMemory fetchClassTagOf: implicitReceiver.
  	self assert: lkupClassTag ~= objectMemory nilObject.
  	self commonSend!

Item was changed:
  ----- Method: StackInterpreter>>findApplicationOfTargetMixin:startingAtBehavior: (in category 'newspeak bytecode support') -----
  findApplicationOfTargetMixin: targetMixin startingAtBehavior: aBehavior
  	"This is used to implement the innards of the pushImplicitReceiverBytecode,
  	 used for outer sends in NS2/NS3.  Find the MixinApplcation of which aBehavior
  	 is a subclass that is an application of targetMixin.  This is an implementation derived from
  
  	<ContextPart> findApplicationOfTargetMixin: targetMixin startingAtBehavior: aBehavior
  	"
  	| mixinOrMixinApplication mixin |
  	mixinOrMixinApplication := aBehavior.
  	[mixinOrMixinApplication = objectMemory nilObject
  	 or: [mixinOrMixinApplication = targetMixin
+ 	 or: [(mixin := objectMemory followObjField: MixinIndex ofObject: mixinOrMixinApplication) = targetMixin
- 	 or: [(mixin := objectMemory fetchPointer: MixinIndex ofObject: mixinOrMixinApplication) = targetMixin
  	 or: [(objectMemory fetchClassOfNonImm: mixin) = targetMixin]]]] whileFalse:
+ 		[mixinOrMixinApplication := objectMemory followObjField: SuperclassIndex ofObject: mixinOrMixinApplication].
- 		[mixinOrMixinApplication := objectMemory fetchPointer: SuperclassIndex ofObject: mixinOrMixinApplication].
  	^mixinOrMixinApplication!

Item was changed:
  ----- Method: StackInterpreter>>instVar:ofContext: (in category 'frame access') -----
  instVar: offset ofContext: aContext
  	"Fetch an instance variable from a maybe married context.
  	 If the context is still married compute the value of the
  	 relevant inst var from the spouse frame's state."
  	| spouseFP |
  	<var: #spouseFP type: #'char *'>
  	<inline: true>
  	self assert: offset < MethodIndex.
  	self assert: (objectMemory isContext: aContext).
  	(self isMarriedOrWidowedContext: aContext) ifFalse:
  		[^objectMemory fetchPointer: offset ofObject: aContext].
  
  	self writeBackHeadFramePointers.
  	(self isWidowedContext: aContext) ifTrue:
  		[^objectMemory fetchPointer: offset ofObject: aContext].
  
  	spouseFP := self frameOfMarriedContext: aContext.
  	offset = SenderIndex ifTrue:
  		[^self ensureCallerContext: spouseFP].
  	offset = StackPointerIndex ifTrue:
  		[self assert: ReceiverIndex + (self stackPointerIndexForFrame: spouseFP) < (objectMemory lengthOf: aContext).
  		^objectMemory integerObjectOf: (self stackPointerIndexForFrame: spouseFP)].
  	offset = InstructionPointerIndex ifTrue:
+ 		[^self instructionPointerForFrame: spouseFP currentFP: localFP currentIP: (self oopForPointer: localIP)].
- 		[^self instructionPointerForFrame: spouseFP currentFP: localFP currentIP: localIP].
  	self error: 'bad index'.
  	^0!

Item was changed:
  ----- Method: StackInterpreter>>instructionPointerForFrame:currentFP:currentIP: (in category 'frame access') -----
  instructionPointerForFrame: spouseFP currentFP: currentFP currentIP: instrPtr
  	"Answer the bytecode pc object (i.e. SmallInteger) for an active frame.  The bytecode
  	 pc is derived from the frame's pc.  If the frame is the top frame on the current stack
  	 the frame pc is whatever the current instruction pointer is.  If the frame is the top
  	 frame on some other stack the frame pc is the value on top of stack.  Otherwise the
  	 frame pc is the saved pc of the frame above.  Once the frame pc is found it must be
  	 mapped to a bytecode pc."
+ 	<var: #spouseFP type: #'char *'>
+ 	<var: #currentFP type: #'char *'>
  	| theIP thePage theFPAbove |
+ 	<var: #thePage type: #'StackPage *'>
+ 	<var: #theFPAbove type: #'char *'>
  	spouseFP = currentFP
  		ifTrue: [theIP := self oopForPointer: instrPtr]
  		ifFalse:
  			[thePage := stackPages stackPageFor: spouseFP.
  			 theFPAbove := self findFrameAbove: spouseFP inPage: thePage.
  			 theIP := theFPAbove == 0
  						ifTrue: [stackPages longAt: thePage headSP]
  						ifFalse:[self oopForPointer: (self frameCallerSavedIP: theFPAbove)]].
  	^self contextInstructionPointer: theIP frame: spouseFP!

Item was added:
+ ----- Method: StackInterpreter>>internalFollowedReceiver (in category 'internal interpreter access') -----
+ internalFollowedReceiver
+ 	<inline: true>
+ 	| rcvr |
+ 	rcvr := stackPages longAt: localFP + FoxReceiver.
+ 	(objectMemory isOopForwarded: rcvr) ifTrue:
+ 		[rcvr := objectMemory followForwarded: rcvr.
+ 		 stackPages longAt: localFP + FoxReceiver put: rcvr].
+ 	^rcvr!

Item was changed:
  ----- Method: StackInterpreter>>pushImplicitReceiverBytecode (in category 'stack bytecodes') -----
  pushImplicitReceiverBytecode
  	"This bytecode is used to implement outer sends in NS2/NS3. The
  	 bytecode takes as an argument the literal offset of a selector. It
  	 effectively finds the nearest lexically-enclosing implementation of
  	 that selector by searching up the static chain of the receiver,
  	 starting at the current method."
+ 	| selector followedReceiver |
- 	| selector |
  	selector := self literal: self fetchByte.
  	self fetchNextBytecode.
+ 	followedReceiver := self internalFollowedReceiver.
  	self internalPush: (self
+ 						implicitReceiverFor: followedReceiver
- 						implicitReceiverFor: self receiver
  						mixin: (self methodClassOf: method)
  						implementing: selector)!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>pathTo:using:followWeak: (in category 'object access primitives') -----
  pathTo: goal using: stack followWeak: followWeak
  	"Trace objects and frames from the root, marking visited objects, pushing the current path on stack, until goal is found.
  	 If found, unmark, leaving path in stack, and answer 0.  Otherwise answer an error:
  		PrimErrBadArgument if stack is not an Array
  		PrimErrBadIndex if search overflows stack
  		PrimErrNotFound if goal cannot be found"
  	| current index next stackSize stackp freeStartAtStart |
  	(objectMemory isArray: stack) ifFalse:
  		[^PrimErrBadArgument].
  	self assert: objectMemory allObjectsUnmarked.
  	freeStartAtStart := objectMemory freeStart. "check no allocations during search"
  	objectMemory beRootIfOld: stack. "so no store checks are necessary on stack"
  	stackSize := objectMemory lengthOf: stack.
  	objectMemory mark: stack.
  	"no need. the current context is not reachable from the active process (suspendedContext is nil)"
  	"objectMemory mark: self activeProcess."
  	current := objectMemory specialObjectsOop.
  	objectMemory mark: current.
  	index := objectMemory lengthOf: current.
  	stackp := 0.
  	[[(index := index - 1) >= -1] whileTrue:
  		[(stackPages couldBeFramePointer: current)
  			ifTrue:
  				[next := index >= 0
  							ifTrue: [self field: index ofFrame: (self cCoerceSimple: current to: #'char *')]
  							ifFalse: [objectMemory nilObject]]
  			ifFalse:
  				[index >= 0
  					ifTrue:
  						[next := (objectMemory isContextNonImm: current)
  									ifTrue: [self fieldOrSenderFP: index ofContext: current]
  									ifFalse: [objectMemory fetchPointer: index ofObject: current]]
  					ifFalse:
  						[next := objectMemory fetchClassOfNonImm: current]].
  		 (stackPages couldBeFramePointer: next)
+ 			ifTrue: [self assert: (self isFrame: (self cCoerceSimple: next to: #'char *')
+ 									onPage: (stackPages stackPageFor: (self cCoerceSimple: next to: #'char *')))]
- 			ifTrue: [self assert: (self isFrame: next onPage: (stackPages stackPageFor: next))]
  			ifFalse: [self assert: (self checkOkayOop: next)].
  		 next = goal ifTrue:
  			[self assert: freeStartAtStart = objectMemory freeStart.
  			 self unmarkAfterPathTo.
  			 objectMemory storePointer: stackp ofObject: stack withValue: current.
  			 self pruneStack: stack stackp: stackp.
  			 ^0].
  		 ((objectMemory isNonIntegerObject: next)
  		  and: [(stackPages couldBeFramePointer: next)
  				ifTrue: [(self frameIsMarked: next) not]
  				ifFalse:
  					[(objectMemory isMarked: next) not
  					  and: [((objectMemory isPointers: next) or: [objectMemory isCompiledMethod: next])
  					  and: [followWeak or: [(objectMemory isWeakNonImm: next) not]]]]])
  			ifTrue:
  				[stackp + 2 > stackSize ifTrue:
  					[self assert: freeStartAtStart = objectMemory freeStart.
  					 self unmarkAfterPathTo.
  					 objectMemory nilFieldsOf: stack.
  					 ^PrimErrBadIndex]. "PrimErrNoMemory ?"
  				 objectMemory
  					storePointerUnchecked: stackp ofObject: stack withValue: current;
  					storePointerUnchecked: stackp + 1 ofObject: stack withValue: (objectMemory integerObjectOf: index).
  				 stackp := stackp + 2.
  				 (stackPages couldBeFramePointer: (self cCoerceSimple: next to: #'char *'))
  					ifTrue:
  						[self markFrame: next.
  						index := self fieldsInFrame: (self cCoerceSimple: next to: #'char *')]
  					ifFalse:
  						[objectMemory mark: next.
  						 (objectMemory isCompiledMethod: next)
  							ifTrue: [index := (objectMemory literalCountOf: next) + LiteralStart]
  							ifFalse: [index := objectMemory lengthOf: next]].
  				 current := next]].
  		 current = objectMemory specialObjectsOop ifTrue:
  			[self assert: freeStartAtStart = objectMemory freeStart.
  			 self unmarkAfterPathTo.
  			 objectMemory nilFieldsOf: stack.
  			^PrimErrNotFound].
  		 index := objectMemory integerValueOf: (objectMemory fetchPointer: stackp - 1 ofObject: stack).
  		 current := objectMemory fetchPointer: stackp - 2 ofObject: stack.
  		 stackp := stackp - 2] repeat!

Item was changed:
  ----- Method: VMMaker class>>generateAllNewspeakConfigurationsUnderVersionControl (in category 'configurations') -----
  generateAllNewspeakConfigurationsUnderVersionControl
  	self generateNewspeakCogVM;
+ 		generateNewspeakSpurStackVM;
  		generateNewspeakSpurCogVM!



More information about the Vm-dev mailing list