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

commits at source.squeak.org commits at source.squeak.org
Thu Jun 21 17:41:17 UTC 2012


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

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

Name: VMMaker.oscog-eem.162
Author: eem
Time: 21 June 2012, 10:38:46.248 am
UUID: 36d9eb65-b5ba-4cf1-bb28-a02cb0d35e49
Ancestors: VMMaker.oscog-eem.161

Make wakeHighestPriority filter-out zombie processes (to fix
Newspeak/Glue crash).

Describe a heap walking scheme for the new object representation.

Fix typos and var name/method clashes.

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

Item was changed:
  ----- Method: CoInterpreter>>implicitReceiverFor:mixin:implementing: (in category 'newspeak bytecode support') -----
+ implicitReceiverFor: rcvr mixin: mixin implementing: selector
- implicitReceiverFor: receiver mixin: mixin implementing: selector
  	"This is used to implement the innards of the pushImplicitReceiverBytecode,
  	 used for implicit receiver sends in NS2/NS3.  Find the nearest lexically-enclosing
  	 implementation of selector by searching up the static chain of anObject,
  	 starting at mixin's application.  This is an iterative implementation derived from
  
  	<ContextPart> implicitReceiverFor: obj <Object>
  					withMixin: mixin <Mixin>
  					implementing: selector <Symbol> ^<Object>"
  
  	<api>
  	<option: #NewspeakVM>
  	cogit breakOnImplicitReceiver ifTrue:
  		[self sendBreak: selector + BaseHeaderSize
  			point: (objectMemory lengthOf: selector)
  			receiver: nil].
+ 	^super implicitReceiverFor: rcvr mixin: mixin implementing: selector!
- 	^super implicitReceiverFor: receiver mixin: mixin implementing: selector!

Item was changed:
  ----- Method: CoInterpreterMT>>wakeHighestPriority (in category 'process primitive support') -----
  wakeHighestPriority
  	"Return the highest priority process that is ready to run.
  	 To save time looking at many empty lists before finding a
  	 runnable process the VM maintains a variable holding the
  	 highest priority runnable process.  If this variable is 0 then the
  	 VM does not know the highest priority and must search all lists.
- 	 Note: It is a fatal VM error if there is no runnable process, but
- 	 the test can't be done here.
  
  	 Override to answer nil when there is no runnable process instead of
  	 aborting.  In the threaded VM the abort test is done in transferTo:from:
  	 becaue there may be some thread waiting to own the VM.  The transfer
  	 to the thread shouldn't be done here because not all clients call this in
  	 the right context (allowing a longjmp back to the threadSchedulingLoop)."
+ 	| schedLists p processList proc ctxt |
- 	| schedLists p processList |
  	schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
  	p := highestRunnableProcessPriority = 0
  			ifTrue: [objectMemory fetchWordLengthOf: schedLists]
  			ifFalse: [highestRunnableProcessPriority].
+ 	[(p := p - 1) >= 0] whileTrue:
+ 		[processList := objectMemory fetchPointer: p ofObject: schedLists.
+ 	 	 [self isEmptyList: processList] whileFalse:
+ 			["Only answer processes with a runnable suspendedContext.
+ 			  Discard those that aren't; the VM would crash otherwise."
+ 			 proc := self removeFirstLinkOfList: processList.
+ 			 ctxt := objectMemory fetchPointer: SuspendedContextIndex ofObject: proc.
+ 			 (self isLiveContext: ctxt) ifTrue:
+ 				[highestRunnableProcessPriority := p + 1.
+ 				^proc].
+ 			 self warning: 'evicted zombie process from run queue']].
+ 	^nil!
- 	p := p - 1.
- 	"index of last indexable field"
- 	[processList := objectMemory fetchPointer: p ofObject: schedLists.
- 	 self isEmptyList: processList] whileTrue:
- 		[(p := p - 1) < 0 ifTrue:
- 			[^nil]].
- 	highestRunnableProcessPriority := p + 1.
- 	^self removeFirstLinkOfList: processList!

Item was changed:
  ----- Method: CoInterpreterPrimitives>>primitiveResume (in category 'process primitives') -----
  primitiveResume
  	"Put this process on the scheduler's lists thus allowing it to proceed next time there is
  	 a chance for processes of it's priority level.  It must go to the back of its run queue so
  	 as not to preempt any already running processes at this level.  If the process's priority
  	 is higher than the current process, preempt the current process."
  	| proc inInterpreter |
  	proc := self stackTop.  "rcvr"
  	(self isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)) ifFalse:
  		[^self primitiveFail].
  	"We're about to switch process, either to an interpreted frame or a
  	 machine code frame. To know whether to return or enter machine code
  	 we have to know from whence we came.  We could have come from the
  	 interpreter, either directly or via a machine code primitive.  We could have
  	 come from machine code.  The instructionPointer tells us where from:"
  	inInterpreter := instructionPointer >= objectMemory startOfMemory.
+ 	(self resume: proc preemptedYieldingIf: preemptionYields from: CSResume) ifTrue:
- 	(self resume: proc  preemptedYieldingIf: preemptionYields from: CSResume) ifTrue:
  		[self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]
  
  	"Personally I would like to check MyList, which should not be one of the elements of the scheduler lists.
+ 	 But there are awful race conditions in things like should:notTakeMoreThan: that mean we can't.
- 	 But there are auful race consitions in things like should:notTakeMoreThan: that mean we can't.
  	 eem 9/27/2010 23:08. e.g.
  
  	| proc myList classLinkedList |
  	proc := self stackTop.
  	myList := objectMemory fetchPointer: MyListIndex ofObject: proc.
  	classLinkedList := self superclassOf: (objectMemory splObj: ClassSemaphore).
  	((self fetchClassOfNonInt: myList) ~= classLinkedList
  	and: [self isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)]) ifFalse:
  		[^self primitiveFail].
  	''We're about to switch process, either to an interpreted frame or a
  	 machine code frame. To know whether to return or enter machine code
  	 we have to know from whence we came.  We could have come from the
  	 interpreter, either directly or via a machine code primitive.  We could have
  	 come from machine code.  The instructionPointer tells us where from:''
  	inInterpreter := instructionPointer >= objectMemory startOfMemory.
  	(self resume: proc  preemptedYieldingIf: preemptionYields from: CSResume) ifTrue:
  		[self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]"!

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

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveResume (in category 'process primitives') -----
  primitiveResume
  	"Put this process on the scheduler's lists thus allowing it to proceed next time there is
  	 a chance for processes of it's priority level.  It must go to the back of its run queue so
  	 as not to preempt any already running processes at this level.  If the process's priority
  	 is higher than the current process, preempt the current process."
  	| proc |
  	proc := self stackTop.  "rcvr"
  	(self isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)) ifFalse:
  		[^self primitiveFail].
  	self resume: proc preemptedYieldingIf: preemptionYields
  
  	"Personally I would like to check MyList, which should not be one of the elements of the scheduler lists.
+ 	 But there are awful race conditions in things like should:notTakeMoreThan: that mean we can't.
- 	 But there are auful race consitions in things like should:notTakeMoreThan: that mean we can't.
  	 eem 9/27/2010 23:08. e.g.
  
  	| proc myList classLinkedList |
  	proc := self stackTop.
  	myList := objectMemory fetchPointer: MyListIndex ofObject: proc.
  	classLinkedList := self superclassOf: (objectMemory splObj: ClassSemaphore).
  	((self fetchClassOfNonInt: myList) ~= classLinkedList
  	and: [self isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)]) ifFalse:
  		[^self primitiveFail].
  	self resume: proc preemptedYieldingIf: preemptionYields"!

Item was changed:
  ----- Method: StackInterpreter>>implicitReceiverFor:mixin:implementing: (in category 'newspeak bytecode support') -----
+ implicitReceiverFor: rcvr mixin: mixin implementing: selector
- implicitReceiverFor: receiver mixin: mixin implementing: selector
  	"This is used to implement the innards of the pushImplicitReceiverBytecode,
  	 used for implicit receiver sends in NS2/NS3.  Find the nearest lexically-enclosing
  	 implementation of selector by searching up the static chain of anObject,
  	 starting at mixin's application.  This is an iterative implementation derived from
  
  	<ContextPart> implicitReceiverFor: obj <Object>
  					withMixin: mixin <Mixin>
  					implementing: selector <Symbol> ^<Object>"
  	<api>
  	<option: #NewspeakVM>
  	| mixinApplication dictionary found |
  	messageSelector := selector. "messageSelector is an implicit parameter of lookupMethodInDictionary:"
  	mixinApplication := self
  							findApplicationOfTargetMixin: mixin
+ 							startingAtBehavior: (objectMemory fetchClassOf: rcvr).
- 							startingAtBehavior: (objectMemory fetchClassOf: receiver).
  	 mixinApplication = objectMemory nilObject ifTrue:
+ 		[^rcvr].
- 		[^receiver].
  	 dictionary := objectMemory fetchPointer: MethodDictionaryIndex ofObject: mixinApplication.
  	 found := self lookupMethodInDictionary: dictionary.
  	 found ifFalse:
  		[| implicitReceiverOrNil theMixin |
  		 theMixin := objectMemory fetchPointer: MixinIndex ofObject: mixinApplication.
  		 implicitReceiverOrNil := self nextImplicitReceiverFor: (self fetchPointer: EnclosingObjectIndex
  																ofObject: mixinApplication)
  									withMixin: (self fetchPointer: EnclosingMixinIndex ofObject: theMixin).
  		 implicitReceiverOrNil ~= objectMemory nilObject ifTrue:
  			[^implicitReceiverOrNil]].
+ 	^rcvr!
- 	^receiver!

Item was changed:
  ----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') -----
  printOopShortInner: oop
  	| classOop name nameLen |
  	<var: #name type: #'char *'>
  	<inline: true>
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[self printNum: (objectMemory integerValueOf: oop);
  			printChar: $(;
  			printHex: (objectMemory integerValueOf: oop);
  			printChar: $).
  		 ^nil].
  	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
  		[self printHex: oop; print: ' is not on the heap'.
  		 ^nil].
  	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[self printHex: oop; print: ' is misaligned'.
  		 ^nil].
  	(self isFloatObject: oop) ifTrue:
  		[self printFloat: (self dbgFloatValueOf: oop).
  		 ^nil].
  	classOop := objectMemory fetchClassOfNonInt: oop.
  	(objectMemory addressCouldBeObj: classOop) ifFalse:
  		[self print: 'a ??'. ^nil].
  	(objectMemory sizeBitsOf: classOop) = metaclassSizeBytes ifTrue:
  		[self printNameOfClass: oop count: 5.
  		 ^nil].
  	oop = objectMemory nilObject ifTrue: [self print: 'nil'. ^nil].
  	oop = objectMemory trueObject ifTrue: [self print: 'true'. ^nil].
  	oop = objectMemory falseObject ifTrue: [self print: 'false'. ^nil].
  	nameLen := self lengthOfNameOfClass: classOop.
  	nameLen = 0 ifTrue: [self print: 'a ??'. ^nil].
  	name := self nameOfClass: classOop.
  	nameLen = 10 ifTrue:
  		[(self str: name n: 'ByteString' cmp: 10) not "strncmp is weird" ifTrue:
  			[self printChar: $'; printStringOf: oop; printChar: $'.
  			 ^nil].
  		 (self str: name n: 'ByteSymbol' cmp: 10) not "strncmp is weird" ifTrue:
  			[self printChar: $#; printStringOf: oop.
  			 ^nil]].
  	(nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) not]) ifTrue:
  		[self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop)).
  		 ^nil].
  	self cCode: [self prin: 'a(n) %.*s' t: nameLen f: name]
  		inSmalltalk: [self print: 'a(n) '; print: name].
  	"Try to spot association-like things; they're all subclasses of LookupKey"
  	((objectMemory instanceSizeOf: classOop) = (ValueIndex + 1)
+ 	 and: [(self superclassOf: classOop) = (self superclassOf: (objectMemory fetchClassOfNonInt: (objectMemory splObj: SchedulerAssociation)))
- 	 and: [(self superclassOf: classOop) = (self superclassOf: (self fetchClassOfNonInt: (objectMemory splObj: SchedulerAssociation)))
  	 and: [self isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop)]]) ifTrue:
  		[self space;
  			printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop);
  			print: ' -> ';
  			printHex: (objectMemory fetchPointer: ValueIndex ofObject: oop)]!

Item was changed:
  ----- Method: StackInterpreter>>putToSleep:yieldingIf: (in category 'process primitive support') -----
  putToSleep: aProcess yieldingIf: yieldImplicitly
  	"Save the given process on the scheduler process list for its priority,
  	 adding to the back if yieldImplicitly or to the front if not yieldImplicitly."
  
  	| priority processLists processList |
+ 	self assert: (framePointer - stackPointer) < LargeContextSize.
- 	self assert:  (framePointer - stackPointer) < LargeContextSize.
  	priority := self quickFetchInteger: PriorityIndex ofObject: aProcess.
  	(highestRunnableProcessPriority ~= 0
  	 and: [priority > highestRunnableProcessPriority]) ifTrue:
  		[highestRunnableProcessPriority := priority].
  	processLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
  	processList := objectMemory fetchPointer: priority - 1 ofObject: processLists.
  	yieldImplicitly
  		ifTrue: [self addLastLink: aProcess toList: processList]
  		ifFalse: [self addFirstLink: aProcess toList: processList]!

Item was changed:
  ----- Method: StackInterpreter>>snapshot: (in category 'image save/restore') -----
  snapshot: embedded 
  	"update state of active context"
  	| activeContext activeProc dataSize rcvr setMacType stackIndex |
  	<var: #setMacType type: 'void *'>
  
  	"Need to convert all frames into contexts since the snapshot file only holds objects."
  	self push: instructionPointer.
  	activeContext := self voidVMStateForSnapshot.
- 	objectMemory pushRemappableOop: activeContext.
  
  	"update state of active process"
  	activeProc := self activeProcess.
  	objectMemory
  		storePointer: SuspendedContextIndex
  		ofObject: activeProc
  		withValue: activeContext.
  
+ 	objectMemory pushRemappableOop: activeContext.
+ 
  	"compact memory and compute the size of the memory actually in use"
  	objectMemory incrementalGC.
  
  	"maximimize space for forwarding table"
  	objectMemory fullGC.
  	self snapshotCleanUp.
  
  	"Nothing moves from here on so it is safe to grab the activeContext again."
  	activeContext := objectMemory popRemappableOop.
  
  	dataSize := objectMemory freeStart - objectMemory startOfMemory. "Assume all objects are below the start of the free block"
  	self successful ifTrue:
  		["Without contexts or stacks simulate
  			rcvr := self popStack.
  			''pop rcvr''
  			self push: trueObj.
  		  to arrange that the snapshot resumes with true.  N.B. stackIndex is one-relative."
  		stackIndex := self quickFetchInteger: StackPointerIndex ofObject: activeContext.
  		rcvr := objectMemory fetchPointer: stackIndex + CtxtTempFrameStart - 1 ofObject: activeContext.
  		objectMemory storePointerUnchecked: stackIndex + CtxtTempFrameStart - 1
  			ofObject: activeContext
  			withValue: objectMemory trueObject.
  		"now attempt to write the snapshot file"
  		self writeImageFile: dataSize.
  		embedded ifFalse:
  			["set Mac file type and creator; this is a noop on other platforms"
  			setMacType := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'.
  			setMacType = 0 ifFalse:
  				[self cCode: '((sqInt (*)(char *, char *, char *))setMacType)(imageName, "STim", "FAST")']].
  		"Without contexts or stacks simulate
  			self pop: 1"
  		objectMemory storePointerUnchecked: StackPointerIndex
  			ofObject: activeContext
  			withValue: (objectMemory integerObjectOf: stackIndex - 1)].
  
  	self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
  	self successful
  		ifTrue: [self push: objectMemory falseObject]
  		ifFalse: [self push: rcvr]!

Item was changed:
  ----- Method: StackInterpreter>>wakeHighestPriority (in category 'process primitive support') -----
  wakeHighestPriority
  	"Return the highest priority process that is ready to run.
  	 To save time looking at many empty lists before finding a
  	 runnable process the VM maintains a variable holding the
  	 highest priority runnable process.  If this variable is 0 then the
  	 VM does not know the highest priority and must search all lists.
  	 Note: It is a fatal VM error if there is no runnable process."
+ 	| schedLists p processList proc ctxt |
- 	| schedLists p processList |
  	schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
  	p := highestRunnableProcessPriority = 0
  			ifTrue: [objectMemory fetchWordLengthOf: schedLists]
  			ifFalse: [highestRunnableProcessPriority].
+ 	[(p := p - 1) >= 0] whileTrue:
+ 		[processList := objectMemory fetchPointer: p ofObject: schedLists.
+ 	 	 [self isEmptyList: processList] whileFalse:
+ 			["Only answer processes with a runnable suspendedContext.
+ 			  Discard those that aren't; the VM would crash otherwise."
+ 			 proc := self removeFirstLinkOfList: processList.
+ 			 ctxt := objectMemory fetchPointer: SuspendedContextIndex ofObject: proc.
+ 			 (self isLiveContext: ctxt) ifTrue:
+ 				[highestRunnableProcessPriority := p + 1.
+ 				^proc].
+ 			 self warning: 'evicted zombie process from run queue']].
+ 	self error: 'scheduler could not find a runnable process'.
+ 	^nil!
- 	p := p - 1.
- 	"index of last indexable field"
- 	[processList := objectMemory fetchPointer: p ofObject: schedLists.
- 	 self isEmptyList: processList] whileTrue:
- 		[(p := p - 1) < 0 ifTrue:
- 			[self error: 'scheduler could not find a runnable process']].
- 	highestRunnableProcessPriority := p + 1.
- 	^self removeFirstLinkOfList: processList!

Item was removed:
- ----- Method: StackInterpreterSimulator>>primitiveResume (in category 'debugging traps') -----
- primitiveResume
- 	"Catch errors before we start the whole morphic error process"
- 
- 	"byteCount > 1000000 ifTrue: [self halt]."  "Ignore early process activity"
- 	^ super primitiveResume!



More information about the Vm-dev mailing list