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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 23 16:09:34 UTC 2013


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

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

Name: VMMaker.oscog-eem.404
Author: eem
Time: 23 September 2013, 9:04:39.698 am
UUID: fae95a07-0615-4c4d-99d8-b515df1e9464
Ancestors: VMMaker.oscog-eem.403

Repair the SistaStackToRegisterMappingCogit.  Major fix is to
reimplement SistaStackToRegisterMappingCogit>>mapFor:bcpc:performUntil:arg:
after framelessness changes.
Also make sure that ObjectMemory>>remapObj: is not <api>.

Fix some slips (e.g. missing period in StackInterpreter>>snapshot:).

Make sure that InterpreterPrimitives>>primitiveBehaviorHash cuts
back the stack by argumentCount for use by Newspeak VM mirrors.

Nuke unused longFormatForNumBytes:

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

Item was changed:
  ----- Method: CCodeGenerator>>addMethodFor:selector: (in category 'utilities') -----
  addMethodFor: aClass selector: selector
  	"Add the given method to the code base and answer its translation
  	 or nil if it shouldn't be translated."
  
  	| method tmethod |
  	method := aClass compiledMethodAt: selector.
  	(method pragmaAt: #doNotGenerate) ifNotNil:
  		[^nil].
  	"process optional methods by interpreting the argument to the option: pragma as either
  	 a Cogit class name or a class variable name or a variable name in VMBasicConstants."
  	(method pragmaAt: #option:) ifNotNil:
  		[:pragma| | key |
  		key := pragma argumentAt: 1.
  		((Cogit withAllSubclasses anySatisfy: [:c| c name = key])
  		and: [VMClass getVMMaker cogitClassName ~= key]) ifTrue:
  			[^nil].
  		(aClass bindingOf: key) ifNotNil:
  			[:binding|
+ 			binding value == false ifTrue: [^nil]].
- 			binding value ifFalse: [^nil]].
  		(VMBasicConstants bindingOf: key) ifNotNil:
  			[:binding|
+ 			binding value == false ifTrue: [^nil]]].
- 			binding value ifFalse: [^nil]]].
  	tmethod := self addMethod: (self compileToTMethodSelector: selector in: aClass).
  	"If the method has a macro then add the macro.  But keep the method
  	 for analysis purposes (e.g. its variable accesses)."
  	(method pragmaAt: #cmacro:) ifNotNil:
  		[:pragma|
  		self addMacro: (pragma argumentAt: 1) for: selector.
  		tmethod inline: false].
  	(method propertyValueAt: #cmacro:) ifNotNil:
  		[:macro|
  		self addMacro: macro for: selector.
  		tmethod inline: false].
  	^tmethod!

Item was added:
+ ----- Method: CoInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
+ followForwardingPointersInStackZone: becomeEffectsFlags
+ 	"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
+ 	 The read-barrier is minimised by arranging that forwarding pointers will fail a method cache probe,
+ 	 since notionally objects' internals are accessed only via sending messages to them (the exception
+ 	 is primitives that access the internals of the non-receiver argument(s)..
+ 	 To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and methods
+ 	 in the stack zone and follow any forwarded ones.  This is of course way cheaper than scanning all
+ 	 of memory as in the old become."
+ 	| theIPPtr |
+ 	<inline: false>
+ 	<var: #thePage type: #'StackPage *'>
+ 	<var: #theSP type: #'char *'>
+ 	<var: #theFP type: #'char *'>
+ 	<var: #callerFP type: #'char *'>
+ 	<var: #theIPPtr type: #'char *'>
+ 
+ 	(becomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
+ 		[(objectMemory isForwarded: method) ifTrue:
+ 			[theIPPtr := instructionPointer - method.
+ 			 method := objectMemory followForwarded: method.
+ 			 instructionPointer := method + theIPPtr].
+ 		(objectMemory isForwarded: newMethod) ifTrue:
+ 			[newMethod := objectMemory followForwarded: newMethod]].
+ 
+ 	self assert: stackPage ~= 0.
+ 	0 to: numStackPages - 1 do:
+ 		[:i| | thePage theSP theFP callerFP oop offset |
+ 		thePage := stackPages stackPageAt: i.
+ 		thePage isFree ifFalse:
+ 			[theSP := thePage headSP.
+ 			 theFP := thePage  headFP.
+ 			 "Skip the instruction pointer on top of stack of inactive pages."
+ 			 thePage = stackPage
+ 				ifTrue: [theIPPtr := 0]
+ 				ifFalse:
+ 					[theIPPtr := theSP.
+ 					 theSP := theSP + BytesPerWord].
+ 			 [self assert: (thePage addressIsInPage: theFP).
+ 			  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
+ 			  offset := theFP + (self frameStackedReceiverOffset: theFP).
+ 			  oop := stackPages longAt: offset.
+ 			  ((objectMemory isNonImmediate: oop)
+ 			   and: [(objectMemory isForwarded: oop)]) ifTrue:
+ 				[stackPages
+ 					longAt: offset
+ 					put: (objectMemory followForwarded: oop)].
+ 			  ((self frameHasContext: theFP)
+ 			   and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
+ 				[stackPages
+ 					longAt: theFP + FoxThisContext
+ 					put: (objectMemory followForwarded: (self frameContext: theFP))].
+ 			 (self isMachineCodeFrame: theFP)
+ 				ifTrue:
+ 					[oop := stackPages longAt: theFP + FoxIFReceiver.
+ 					 ((objectMemory isNonImmediate: oop)
+ 					  and: [(objectMemory isForwarded: oop)]) ifTrue:
+ 						[stackPages
+ 							longAt: theFP + FoxIFReceiver
+ 							put: (objectMemory followForwarded: oop)].
+ 					 self assert: (objectMemory isForwarded: (self frameMethodObject: theFP)) not]
+ 				ifFalse:
+ 					[oop := stackPages longAt: theFP + FoxIFReceiver.
+ 					 ((objectMemory isNonImmediate: oop)
+ 					  and: [(objectMemory isForwarded: oop)]) ifTrue:
+ 						[stackPages
+ 							longAt: theFP + FoxIFReceiver
+ 							put: (objectMemory followForwarded: oop)].
+ 					 oop := self frameMethod: theFP.
+ 					 (objectMemory isForwarded: oop) ifTrue:
+ 						[| delta |
+ 						 delta := (objectMemory followForwarded: oop) - oop.
+ 						 (theIPPtr ~= 0
+ 						  and: [(stackPages longAt: theIPPtr) > (self frameMethod: theFP)]) ifTrue:
+ 							[stackPages
+ 								longAt: theIPPtr
+ 								put: (stackPages longAt: theIPPtr) + delta].
+ 						stackPages
+ 							longAt: theFP + FoxIFSavedIP
+ 							put: (stackPages longAt: theFP + FoxIFSavedIP) + delta.
+ 						stackPages
+ 							longAt: theFP + FoxMethod
+ 							put: (objectMemory followForwarded: oop)]].
+ 			  self followNecessaryForwardingInMethod: (self frameMethod: theFP).
+ 			  (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ 				[theIPPtr := theFP + FoxCallerSavedIP.
+ 				 theFP := callerFP]]]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveBehaviorHash (in category 'object access primitives') -----
  primitiveBehaviorHash
  	| hashOrError |
  	self assert: ((objectMemory isNonImmediate: self stackTop)
  				 and: [self addressCouldBeClassObj: self stackTop]).
  	hashOrError := objectMemory ensureBehaviorHash: self stackTop.
  	hashOrError >= 0
+ 		ifTrue: [self pop: argumentCount + 1 thenPushInteger: hashOrError]
- 		ifTrue: [self pop: 1 thenPushInteger: hashOrError]
  		ifFalse: [self primitiveFailFor: hashOrError negated]!

Item was added:
+ ----- Method: ObjectMemory>>isIndexableFormat: (in category 'header access') -----
+ isIndexableFormat: format
+ 	^format >= self arrayFormat
+ 	  and: [format <= self weakArrayFormat
+ 			or: [format >= self firstLongFormat]]!

Item was removed:
- ----- Method: ObjectMemory>>longFormatForNumBytes: (in category 'header access') -----
- longFormatForNumBytes: numBytes
- 	"In ObjectMemory the odd bits for 32-bit indexable objects, needed in the 64-bit VM, is
- 	 not stored in the format field."
- 	^self firstLongFormat!

Item was changed:
  ----- Method: ObjectMemory>>remapObj: (in category 'gc -- compaction') -----
  remapObj: obj
- 	<api>
  	"Map the given oop to its new value during a compaction or become: operation."
  	<inline: false>
  	^self remappedObj: obj!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>allocateCounters (in category 'initialization') -----
  allocateCounters
  	"Allocate the structures used to manage counting conditional branch
  	 compilation.  This  needs to be a macro since the structures are alloca'ed
  	 (stack allocated) to ensure their being freed when compilation is done."
  	<cmacro: '() do { \
  		counters = numCounters ? alloca(sizeof(AbstractInstruction) * numCounters) : 0; \
  } while (0)'>
  	counters := CArrayAccessor on:
  					((1 to: numCounters) collect:
+ 						[:ign| backEnd class new])!
- 						[:ign| CogAbstractInstruction new])!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>fillInCounters:atEndAddress: (in category 'generate machine code') -----
  fillInCounters: nCounters atEndAddress: endAddress
  	endAddress - (nCounters * CounterBytes)
  		to: endAddress - CounterBytes
+ 		by: CounterBytes
  		do: [:address|
  			objectMemory
  				long32At: address
  				put: (initialCounterValue << 16 + initialCounterValue)]!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') -----
  mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg
  	"Machine-code <-> bytecode pc mapping support.  Evaluate functionSymbol
  	 for each mcpc, bcpc pair in the map until the function returns non-zero,
+ 	 answering that result, or 0 if it fails to.  This works only for frameful methods."
- 	 answering that result, or 0 if it fails to.  This works only for frameful methods.
- 
- 	 Override to add the descriptor as the first argument to function."
  	<var: #cogMethod type: #'CogBlockMethod *'>
  	<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(BytecodeDescriptor * desc, char *mcpc, sqInt bcpc, void *arg)'>
  	<var: #arg type: #'void *'>
  	| isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result
  	  latestContinuation byte descriptor bsOffset nExts |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #homeMethod type: #'CogMethod *'>
  	self assert: cogMethod stackCheckOffset > 0.
  	"In both CMMethod and CMBlock cases find the start of the map and
  	 skip forward to the bytecode pc map entry for the stack check."
  	cogMethod cmType = CMMethod
  		ifTrue:
  			[isInBlock := false.
  			 homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'.
  			 self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader).
  			 map := self mapStartFor: homeMethod.
  			 self assert: ((objectMemory byteAt: map) >> AnnotationShift = IsAbsPCReference
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsRelativeCall
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]).
  			 latestContinuation := startbcpc.
  			 aMethodObj := homeMethod methodObject.
  			 endbcpc := (objectMemory byteLengthOf: aMethodObj) - 1.
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader]
  		ifFalse:
  			[isInBlock := true.
  			 homeMethod := cogMethod cmHomeMethod.
  			 map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod)
  						inMethod: homeMethod.
  			 self assert: map ~= 0.
  			 self assert: ((objectMemory byteAt: map) >> AnnotationShift = HasBytecodePC "fiducial"
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]).
  			 [(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
  				[map := map - 1].
  			 map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header."
  			 aMethodObj := homeMethod methodObject.
  			 bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader).
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader.
  			 byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
  			 descriptor := self generatorAt: byte.
  			 endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj].
  	bcpc := startbcpc.
  	mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset.
  	nExts := 0.
  	"as a hack for collecting counters, remember the prev mcpc in a static variable."
  	prevMapAbsPCMcpc := 0.
  	"The stack check maps to the start of the first bytecode,
  	 the first bytecode being effectively after frame build."
  	result := self perform: functionSymbol
  					with: nil
  					with: (self cCoerceSimple: mcpc to: #'char *')
  					with: startbcpc
  					with: arg.
  	result ~= 0 ifTrue:
  		[^result].
  	"Now skip up through the bytecode pc map entry for the stack check." 
  	[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
  		[map := map - 1].
  	map := map - 1.
  	[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc"
  		[mapByte >= FirstAnnotation
  			ifTrue:
  				[| annotation nextBcpc |
  				annotation := mapByte >> AnnotationShift.
  				mcpc := mcpc + (mapByte bitAnd: DisplacementMask).
  				(self isPCMappedAnnotation: annotation alternateInstructionSet: bsOffset > 0) ifTrue:
  					[[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
  					  descriptor := self generatorAt: byte.
  					  isInBlock
  						ifTrue: [bcpc >= endbcpc ifTrue: [^0]]
  						ifFalse:
  							[(descriptor isReturn and: [bcpc >= latestContinuation]) ifTrue: [^0].
  							 (descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
  								[| targetPC |
  								 targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  								 latestContinuation := latestContinuation max: targetPC]].
  					  nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  					  descriptor isMapped
  					  or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse:
  						[bcpc := nextBcpc.
  						 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  					"All subsequent bytecodes except backward branches map to the
  					 following bytecode. Backward branches map to themselves other-
  					 wise mapping could cause premature breaking out of loops." 
  					result := self perform: functionSymbol
  									with: descriptor
  									with: (self cCoerceSimple: mcpc to: #'char *')
+ 									with: ((descriptor isBranch
+ 										   and: [self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj])
- 									with: ((self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj)
  											ifTrue: [bcpc]
  											ifFalse: [bcpc + descriptor numBytes])
  									with: arg.
  					 result ~= 0 ifTrue:
  						[^result].
+ 					 bcpc := nextBcpc.
+ 					 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
- 					 bcpc := nextBcpc].
  				annotation = IsAbsPCReference ifTrue:
  					[prevMapAbsPCMcpc := mcpc]]
  			ifFalse:
  				[mcpc := mcpc + (mapByte >= DisplacementX2N
  									ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
  									ifFalse: [mapByte])].
  		 map := map - 1].
  	^0!

Item was removed:
- ----- Method: Spur32BitMemoryManager>>longFormatForNumBytes: (in category 'header format') -----
- longFormatForNumBytes: numBytes
- 	^self firstLongFormat!

Item was changed:
  ----- Method: StackInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
  followForwardingPointersInStackZone: becomeEffectsFlags
  	"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
  	 The read-barrier is minimised by arranging that forwarding pointers will fail a method cache probe,
  	 since notionally objects' internals are accessed only via sending messages to them (the exception
  	 is primitives that access the internals of the non-receiver argument(s)..
  	 To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and methods
  	 in the stack zone and follow any forwarded ones.  This is of course way cheaper than scanning all
  	 of memory as in the old become."
  	| theIPPtr |
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #'char *'>
  
  	(becomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  		[(objectMemory isForwarded: method) ifTrue:
  			[theIPPtr := instructionPointer - method.
  			 method := objectMemory followForwarded: method.
  			 instructionPointer := method + theIPPtr].
  		(objectMemory isForwarded: newMethod) ifTrue:
  			[newMethod := objectMemory followForwarded: newMethod]].
  
  	self assert: stackPage ~= 0.
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP theIP oop |
  		thePage := stackPages stackPageAt: i.
  		thePage isFree ifFalse:
  			[theSP := thePage headSP.
  			 theFP := thePage  headFP.
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage
  				ifTrue: [theIPPtr := 0]
  				ifFalse:
  					[theIPPtr := theSP.
  					 theSP := theSP + BytesPerWord].
  			 [self assert: (thePage addressIsInPage: theFP).
  			  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
  			  oop := stackPages longAt: theFP + FoxReceiver.
  			  ((objectMemory isNonImmediate: oop)
  			   and: [(objectMemory isForwarded: oop)]) ifTrue:
  				[stackPages
  					longAt: theFP + FoxReceiver
  					put: (objectMemory followForwarded: oop)].
  			  theIP := theFP + (self frameStackedReceiverOffset: theFP). "reuse theIP; its just an offset here"
  			  oop := stackPages longAt: theIP.
  			  ((objectMemory isNonImmediate: oop)
  			   and: [(objectMemory isForwarded: oop)]) ifTrue:
  				[stackPages
  					longAt: theIP
  					put: (objectMemory followForwarded: oop)].
  			  ((self frameHasContext: theFP)
  			   and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
  					put: (objectMemory followForwarded: (self frameContext: theFP))].
+ 			  oop := self frameMethod: theFP.
+ 			  (objectMemory isForwarded: oop) ifTrue:
+ 				[| delta |
+ 				 theIPPtr ~= 0 ifTrue:
- 			  (objectMemory isForwarded: (self frameMethod: theFP)) ifTrue:
- 				[theIPPtr ~= 0 ifTrue:
  					[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
+ 					 delta := (objectMemory followForwarded: oop) - oop.
+ 					 stackPages
+ 						longAt: theIPPtr
+ 						put: (stackPages longAt: theIPPtr) + delta].
- 					 theIP := (stackPages longAt: theIPPtr) - (self frameMethod: theFP)].
  				stackPages
  					longAt: theFP + FoxMethod
+ 					put: (objectMemory followForwarded: oop)].
- 					put: (objectMemory followForwarded: (self frameMethod: theFP)).
- 			 	 theIPPtr ~= 0 ifTrue:
- 					[stackPages longAt: theIPPtr put: theIP + (self frameMethod: theFP)]].
  			  self followNecessaryForwardingInMethod: (self frameMethod: theFP).
  			  (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theIPPtr := theFP + FoxCallerSavedIP.
  				 theFP := callerFP]]]!

Item was changed:
  ----- Method: StackInterpreter>>objCouldBeClassObj: (in category 'debug support') -----
  objCouldBeClassObj: objOop
  	"Answer if objOop looks like a class object.  WIth Spur be lenient if the object doesn't
  	 yet have a hash (i.e. is not yet in the classTable), and accept forwarding pointers."
  	<inline: false>
+ 	| fieldOop |
- 	| field |
  	^(objectMemory isPointersNonImm: objOop)
  	  and: [(objectMemory numSlotsOf: objOop) >= (InstanceSpecificationIndex+1)
+ 	  and: [fieldOop := objectMemory fetchPointer: SuperclassIndex ofObject: objOop.
+ 			((objectMemory isPointers: fieldOop)
- 	  and: [field := objectMemory fetchPointer: SuperclassIndex ofObject: objOop.
- 			((objectMemory isPointers: field)
  			or: [(objectMemory rawHashBitsOf: objOop) = 0
+ 				and: [(objectMemory isOopForwarded: fieldOop)
+ 				and: [objectMemory isPointers: (objectMemory followForwarded: fieldOop)]]])
+ 	  and: [fieldOop := objectMemory fetchPointer: MethodDictionaryIndex ofObject: objOop.
+ 			((objectMemory isPointers: fieldOop)
- 				and: [(objectMemory isOopForwarded: field)
- 				and: [objectMemory isPointers: (objectMemory followForwarded: field)]]])
- 	  and: [field := objectMemory fetchPointer: MethodDictionaryIndex ofObject: objOop.
- 			((objectMemory isPointers: field)
  			or: [(objectMemory rawHashBitsOf: objOop) = 0
+ 				and: [(objectMemory isOopForwarded: fieldOop)
+ 				and: [objectMemory isPointers: (objectMemory followForwarded: fieldOop)]]])
- 				and: [(objectMemory isOopForwarded: field)
- 				and: [objectMemory isPointers: (objectMemory followForwarded: field)]]])
  	  and: [(objectMemory isIntegerObject: (objectMemory fetchPointer: InstanceSpecificationIndex ofObject: objOop))]]]]!

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 *'>
  
+ 	"For now the stack munging below doesn't deal with more than one argument.
- 	"For nowe the stack munging below doesn't deal with more than omne argument.
  	 It can, and should."
  	argumentCount ~= 0 ifTrue:
  		[^self primitiveFailFor: PrimErrBadNumArgs].
  
  	"Need to convert all frames into contexts since the snapshot file only holds objects."
  	self push: instructionPointer.
  	activeContext := self voidVMStateForSnapshot.
  
  	"update state of active process"
  	activeProc := self activeProcess.
  	objectMemory
  		storePointer: SuspendedContextIndex
  		ofObject: activeProc
  		withValue: activeContext.
  
  	objectMemory pushRemappableOop: activeContext.
  
  	"garbage collect, bereave contexts and flush external methods."
  	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''
- 			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 writeImageFileIO: dataSize.
  		(self successful and: [embedded not]) ifTrue:
  			["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.
  			 self justActivateNewMethod]!

Item was changed:
  ----- Method: StackInterpreter>>snapshotCleanUp (in category 'image save/restore') -----
  snapshotCleanUp
  	"Clean up right before saving an image, garbage collecting, sweeping memory and:
  	* nilling out all fields of contexts above the stack pointer. 
  	* flushing external primitives 
  	* clearing the root bit of any object in the root table
  	* bereaving widowed contexts.
  	 By ensuring that all contexts are single in a snapshot (i.e. that no married contexts
  	 exist) we can maintain the invariant that a married or widowed context's frame
  	 reference (in its sender field) must point into the stack pages since no married or
  	 widowed contexts are present from older runs of the system."
  
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue: [objectMemory flushNewSpace]
+ 		ifFalse: [objectMemory incrementalGC].	"compact memory and compute the size of the memory actually in use"
- 		ifFalse: [objectMemory incrementalGC]	"compact memory and compute the size of the memory actually in use"
  
  	"maximimize space for forwarding table"
  	objectMemory fullGC.
  
  	objectMemory allObjectsDo:
  		[:obj| | header fmt sz |
  		 header := self longAt: obj.
  		 fmt := objectMemory formatOfHeader: header.
  		 "Clean out context"
  		 (fmt = objectMemory indexablePointersFormat
  		  and: [objectMemory isContextHeader: header]) ifTrue:
  			["All contexts have been divorced. Bereave remaining widows."
  			 (self isMarriedOrWidowedContext: obj) ifTrue:
  				[self markContextAsDead: obj].
  			 "Fill slots beyond top of stack with nil"
  			 (self fetchStackPointerOf: obj) to: (objectMemory numSlotsOf: obj) do:
  				[:i | objectMemory
  						storePointerUnchecked: i + CtxtTempFrameStart
  						ofObject: obj
  						withValue: objectMemory nilObject]].
  		 "Clean out external functions from compiled methods"
  		 fmt >= objectMemory firstCompiledMethodFormat ifTrue:
  			["Its primitiveExternalCall"
  			 (self primitiveIndexOf: obj) = PrimitiveExternalCallIndex ifTrue:
  				[self flushExternalPrimitiveOf: obj]]].
  
  	objectMemory hasSpurMemoryManagerAPI ifFalse:
  		[objectMemory clearRootsTable]!

Item was changed:
  ----- Method: VMMaker class>>generateSqueakCogSistaVM (in category 'configurations') -----
  generateSqueakCogSistaVM
  	^VMMaker
+ 		generate: CoInterpreter
- 		generate: (Smalltalk at: ([:choices| choices at: (UIManager default chooseFrom: choices) ifAbsent: [^self]]
- 									value: #(CoInterpreter CoInterpreterMT)))
  		and: SistaStackToRegisterMappingCogit
  		to: (FileDirectory default pathFromURI: 'oscogvm/sistasrc')
  		platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms')
  		excluding: (InterpreterPlugin withAllSubclasses collect: [:ea| ea name])!



More information about the Vm-dev mailing list