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

commits at source.squeak.org commits at source.squeak.org
Mon May 26 19:41:15 UTC 2014


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

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

Name: VMMaker.oscog-eem.733
Author: eem
Time: 26 May 2014, 12:38:43.918 pm
UUID: 6d38bb55-fe48-480d-a606-d577925a2785
Ancestors: VMMaker.oscog-eem.732

Use unsigned comparisons when testing if there's sufficient
heap space in readImageFromFile:HeapSize:StartingAt:.

Remove break in CogVMSimulator>>ceSend:super:to:numArgs:.
Monticello should really check for break methods on commit.

Refactor cloneSimulation into cloneSImulationWindow and
cloneSimulation.  Remember the clone and the parent.  Use
this to make the Spur GC take a clone and push it off the
cliff every global GC to allow repeating GCs that hit bugs.

Add an assert to check that all weaklinks are accessible
(but the bug has already been found with the nextCorpse
encoding bug).

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

Item was changed:
  ----- Method: CoInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
  readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
  	"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
  	"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
  	"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
  
  	| swapBytes headerStart headerSize dataSize oldBaseAddr
  	  minimumMemory heapSize bytesRead bytesToShift firstSegSize
  	  hdrNumStackPages hdrEdenBytes hdrCogCodeSize headerFlags hdrMaxExtSemTabSize |
  	<var: #f type: #sqImageFile>
+ 	<var: #heapSize type: #usqInt>
  	<var: #dataSize type: #'size_t'>
+ 	<var: #minimumMemory type: #usqInt>
  	<var: #desiredHeapSize type: #usqInt>
  	<var: #headerStart type: #squeakFileOffsetType>
  	<var: #imageOffset type: #squeakFileOffsetType>
  
  	metaclassNumSlots := 6.	"guess Metaclass instSize"
  	classNameIndex := 6.		"guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1"
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  	headerStart := (self sqImageFilePosition: f) - BytesPerWord.  "record header start position"
  
  	headerSize			:= self getLongFromFile: f swap: swapBytes.
  	dataSize			:= self getLongFromFile: f swap: swapBytes.
  	oldBaseAddr		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  	objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B.  not used."
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	headerFlags			:= self getLongFromFile: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	extraVMMemory		:= self getLongFromFile: f swap: swapBytes. "N.B.  not used."
  	hdrNumStackPages	:= self getShortFromFile: f swap: swapBytes.
  	"4 stack pages is small.  Should be able to run with as few as
  	 three. 4 should be comfortable but slow.  8 is a reasonable
  	 default.  Can be changed via vmParameterAt: 43 put: n.
  	 Can be set as a preference (Info.plist, VM.ini, command line etc).
  	 If desiredNumStackPages is already non-zero then it has been
  	 set as a preference.  Ignore (but preserve) the header's default."
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	"This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
  	hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
  	cogCodeSize := desiredCogCodeSize ~= 0
  						ifTrue: [desiredCogCodeSize]
  						ifFalse:
  							[hdrCogCodeSize = 0
  									ifTrue: [self defaultCogCodeSize]
  									ifFalse: [hdrCogCodeSize]].
  	hdrEdenBytes		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory edenBytes: (desiredEdenBytes ~= 0
  						ifTrue: [desiredEdenBytes]
  						ifFalse:
  							[hdrEdenBytes = 0
  									ifTrue: [objectMemory defaultEdenBytes]
  									ifFalse: [hdrEdenBytes]]).
  	desiredEdenBytes := hdrEdenBytes.
  	hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
  	hdrMaxExtSemTabSize ~= 0 ifTrue:
  		[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 Preserve it to be polite to other VMs."
  	the2ndUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	firstSegSize := self getLongFromFile: f swap: swapBytes.
  	objectMemory firstSegmentSize: firstSegSize.
  
  	"compare memory requirements with availability"
  	minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed"
  						+ dataSize
  						+ objectMemory newSpaceBytes
  						+ self interpreterAllocationReserveBytes.
  	heapSize             :=  cogCodeSize "no need to include the stackZone; this is alloca'ed"
  						+ desiredHeapSize
  						+ objectMemory newSpaceBytes
  						+ self interpreterAllocationReserveBytes.
  	heapSize < minimumMemory ifTrue:
  		[self insufficientMemorySpecifiedError].
  
  	"allocate a contiguous block of memory for the Squeak heap and ancilliary data structures"
  	objectMemory memory: (self
  								allocateMemory: heapSize
  								minimum: minimumMemory
  								imageFile: f
  								headerSize: headerSize) asUnsignedInteger.
  	objectMemory memory ifNil: [self insufficientMemoryAvailableError].
  
  	heapBase := objectMemory
  					setHeapBase: objectMemory memory + cogCodeSize
  					memoryLimit: objectMemory memory + heapSize
  					endOfMemory: objectMemory memory + cogCodeSize + dataSize.
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	"compute difference between old and new memory base addresses"
  	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	self initializeCodeGenerator.
  	^dataSize!

Item was changed:
  ----- Method: CogVMSimulator>>ceSend:super:to:numArgs: (in category 'trampolines') -----
+ ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs
+ 	"self stringOf: selector"
+ 	"self printOop: rcvr"
+ 	"(superNormalBar ~= 0 and: [(self stringOf: selector) = #bitShift:]) ifTrue:
+ 		[self halt]."
- ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs 
- 	self break.
  	self logSend: selector.
  	cogit assertCStackWellAligned.
+ 	self maybeCheckStackDepth: numArgs + 1 sp: stackPointer pc: (stackPages longAt: stackPointer).
+ 	^super ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs!
- 	self
- 		maybeCheckStackDepth: numArgs + 1
- 		sp: stackPointer
- 		pc: (stackPages longAt: stackPointer).
- 	^ super
- 		ceSend: selector
- 		super: superNormalBar
- 		to: rcvr
- 		numArgs: numArgs!

Item was changed:
  ----- Method: CogVMSimulator>>cloneSimulation (in category 'debug support') -----
  cloneSimulation
  	| savedDisplayView savedDisplayForm savedQuitBlock savedTranscript |
+ 	self setClone: nil.
  	savedDisplayView := displayView. displayView := nil.
  	savedDisplayForm := displayForm. displayForm = nil.
  	savedQuitBlock := quitBlock. quitBlock := nil.
  	savedTranscript := transcript. transcript := nil.
  
+ 	^[| theClone |
+ 	 Smalltalk garbageCollect.
+ 	 theClone := self veryDeepCopy.
+ 	 theClone parent: self; transcript: Transcript.
+ 	 theClone objectMemory parent: objectMemory.
+ 	 self setClone: theClone.
+ 	 objectMemory setClone: theClone objectMemory.
+ 	 theClone]
- 	[| clone window |
- 	 clone := self veryDeepCopy.
- 	 window := clone openAsMorph.
- 	 window setLabel: 'Clone of ', (savedDisplayView containingWindow label allButFirst: 'Simulation of ' size)]
  		ensure:
  			[displayView := savedDisplayView.
  			 displayForm = savedDisplayForm.
  			 quitBlock := savedQuitBlock.
  			 transcript := savedTranscript]!

Item was added:
+ ----- Method: CogVMSimulator>>cloneSimulationWindow (in category 'debug support') -----
+ cloneSimulationWindow
+ 	| label |
+ 	label := 'Clone of ', (displayView containingWindow label allButFirst: 'Simulation of ' size).
+ 	^self cloneSimulation openAsMorph
+ 		setLabel: label;
+ 		yourself!

Item was changed:
  ----- Method: CogVMSimulator>>utilitiesMenu: (in category 'UI') -----
  utilitiesMenu: aMenuMorph
  	aMenuMorph
  		add: 'toggle transcript' action: #toggleTranscript;
+ 		add: 'clone VM' action: #cloneSimulationWindow;
- 		add: 'clone VM' action: #cloneSimulation;
  		addLine;
  		add: 'print ext head frame' action: #printExternalHeadFrame;
  		add: 'print int head frame' action: #printHeadFrame;
  		add: 'print mc/cog frame' action: [self printFrame: cogit processor fp WithSP: cogit processor sp];
  		add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
  		add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
  		add: 'short print mc/cog frame & callers' action: [self shortPrintFrameAndCallers: cogit processor fp];
  		add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
  		add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
  		add: 'long print mc/cog frame & callers' action: [self printFrameAndCallers: cogit processor fp SP: cogit processor sp];
  		add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
  		add: 'print call stack' action: #printCallStack;
  		add: 'print stack call stack' action: #printStackCallStack;
  		add: 'print stack call stack of...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printStackCallStackOf: fp]];
  		add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
  		add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
  		add: 'print all stacks' action: #printAllStacks;
  		add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
  											self writeBackHeadFramePointers];
  		add: 'write back mc ptrs' action: [stackPointer := cogit processor sp. framePointer := cogit processor fp. instructionPointer := cogit processor eip.
  											self writeBackHeadFramePointers];
  		addLine;
  		add: 'print registers' action: [cogit processor printRegistersOn: transcript];
  		add: 'print register map' action: [cogit printRegisterMapOn: transcript];
  		add: 'disassemble method/trampoline...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit disassembleCodeAt: pc]];
  		add: 'disassemble method/trampoline at pc' action: [cogit disassembleCodeAt: cogit processor pc];
  		add: 'disassemble ext head frame method' action: [cogit disassembleMethod: (self frameMethod: framePointer)];
  		add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
  		add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
  		add: 'print context...' action: [(self promptHex: 'print context') ifNotNil: [:oop| self printContext: oop]];
  		addLine;
  		add: 'inspect object memory' target: objectMemory action: #inspect;
  		add: 'inspect cointerpreter' action: #inspect;
  		add: 'inspect cogit' target: cogit action: #inspect;
  		add: 'inspect method zone' target: cogit methodZone action: #inspect.
  	self isThreadedVM ifTrue:
  		[aMenuMorph add: 'inspect thread manager' target: self threadManager action: #inspect].
  	aMenuMorph
  		addLine;
  		add: 'print cog methods' target: cogMethodZone action: #printCogMethods;
  		add: 'print cog methods with prim...' action: [(self promptNum: 'prim index') ifNotNil: [:pix| cogMethodZone printCogMethodsWithPrimitive: pix]];
  		add: 'print trampoline table' target: cogit action: #printTrampolineTable;
  		add: 'print prim trace log' action: #dumpPrimTraceLog;
  		add: 'report recent instructions' target: cogit action: #reportLastNInstructions;
  		add: 'set break pc (', (cogit breakPC isInteger ifTrue: [cogit breakPC hex] ifFalse: [cogit breakPC printString]), ')...' action: [(self promptHex: 'break pc') ifNotNil: [:bpc| cogit breakPC: bpc]];
  		add: (cogit singleStep
  				ifTrue: ['no single step']
  				ifFalse: ['single step'])
  			action: [cogit singleStep: cogit singleStep not];
  		add: (cogit printRegisters
  				ifTrue: ['no print registers each instruction']
  				ifFalse: ['print registers each instruction'])
  			action: [cogit printRegisters: cogit printRegisters not];
  		add: (cogit printInstructions
  				ifTrue: ['no print instructions each instruction']
  				ifFalse: ['print instructions each instruction'])
  			action: [cogit printInstructions: cogit printInstructions not];
  		addLine;
  		add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
  											s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
  		add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
  											s notEmpty ifTrue: [self setBreakSelector: s]];
  		add: 'set break block...' action: [|s| s := UIManager default request: 'break block' initialAnswer: '[:theCogit| false]'.
  											s notEmpty ifTrue: [self setBreakBlockFromString: s]];
  		add: 'set cogit break method...' action: [(self promptHex: 'cogit breakMethod') ifNotNil: [:bm| cogit setBreakMethod: bm]];
  		add: (printBytecodeAtEachStep
  				ifTrue: ['no print bytecode each bytecode']
  				ifFalse: ['print bytecode each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printBytecodeAtEachStep := printBytecodeAtEachStep not];
  		add: (printFrameAtEachStep
  				ifTrue: ['no print frame each bytecode']
  				ifFalse: ['print frame each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printFrameAtEachStep := printFrameAtEachStep not].
  	^aMenuMorph!

Item was changed:
  Spur32BitMemoryManager subclass: #Spur32BitMMLESimulator
+ 	instanceVariableNames: 'clone parent bootstrapping'
- 	instanceVariableNames: 'bootstrapping'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-SpurMemoryManagerSimulation'!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>getClone (in category 'accessing') -----
+ getClone
+ 
+ 	^ clone!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>globalGarbageCollect (in category 'gc - global') -----
+ globalGarbageCollect
+ 	"If we're /not/ a clone, clone the VM and push it over the cliff.
+ 	 If it survives, destroy the clone and continue.  We should be OK until next time."
+ 	parent ifNil:
+ 		[[coInterpreter cloneSimulation objectMemory globalGarbageCollect]
+ 			on: Halt
+ 			do: [:ex|
+ 				(ex messageText beginsWith: 'GC number')
+ 					ifTrue:
+ 						[Transcript cr; cr; show: ex messageText; cr; cr.
+ 						 ex resume]
+ 					ifFalse: [ex pass]].
+ 		 coInterpreter setClone: nil.
+ 		 self setClone: nil.
+ 		 Smalltalk garbageCollect].
+ 	^super globalGarbageCollect!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>parent (in category 'accessing') -----
+ parent
+ 
+ 	^ parent!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>parent: (in category 'accessing') -----
+ parent: anObject
+ 
+ 	parent := anObject!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>setClone: (in category 'accessing') -----
+ setClone: aSpurMMSimulator
+ 
+ 	clone := aSpurMMSimulator!

Item was added:
+ ----- Method: SpurGenerationScavenger>>allFutureSpaceEntitiesDo: (in category 'weakness and ephemerality') -----
+ allFutureSpaceEntitiesDo: aBlock
+ 	"Enumerate all future space objects, including free objects."
+ 	<inline: true>
+ 	| prevObj prevPrevObj objOop limit |
+ 	prevPrevObj := prevObj := nil.
+ 	objOop := manager objectStartingAt: futureSpace start.
+ 	limit := futureSurvivorStart.
+ 	[self oop: objOop isLessThan: limit] whileTrue:
+ 		[aBlock value: objOop.
+ 		 prevPrevObj := prevObj.
+ 		 prevObj := objOop.
+ 		 objOop := manager objectAfter: objOop limit: limit]!

Item was added:
+ ----- Method: SpurGenerationScavenger>>allWeakSurvivorsOnWeakList (in category 'weakness and ephemerality') -----
+ allWeakSurvivorsOnWeakList
+ 	self allFutureSpaceEntitiesDo:
+ 		[:survivor|
+ 		(manager isWeakNonImm: survivor) ifTrue:
+ 			[(self is: survivor onWeaklingList: weakList) ifFalse:
+ 				[^false]]].
+ 	^true!

Item was changed:
  ----- Method: SpurGenerationScavenger>>processWeaklings (in category 'weakness and ephemerality') -----
  processWeaklings
  	"Go through the remembered set and the weak list, nilling references to
  	 any objects that didn't survive the scavenge. Read the class comment
  	 for a more in-depth description of the algorithm."
  	<inline: false>
  	| i rootObj weakCorpse weakObj |
+ 	self assert: self allWeakSurvivorsOnWeakList.
  	i := 0.
  	[i < rememberedSetSize] whileTrue:
  		[rootObj := rememberedSet at: i.
  		(manager isWeakNonImm: rootObj)
  			ifTrue:
  				[self processWeakSurvivor: rootObj.
  				 "If no more referents, remove by overwriting with the last element in the set."
  				 (manager hasYoungReferents: rootObj)
  					ifFalse:
  						[manager setIsRememberedOf: rootObj to: false.
  						 i + 1 < rememberedSetSize ifTrue:
  							[rememberedSet at: i put: (rememberedSet at: rememberedSetSize - 1)].
  						 rememberedSetSize := rememberedSetSize - 1]
  					ifTrue: [i := i + 1]]
  			ifFalse: [i := i + 1]].
  	weakList ifNotNil:
  		[weakCorpse := self firstCorpse: weakList.
  		 [weakCorpse notNil] whileTrue:
  			[self assert: (manager isForwarded: weakCorpse).
  			 weakObj := manager followForwarded: weakCorpse.
  			 self processWeakSurvivor: weakObj.
  			 weakCorpse := self nextCorpseOrNil: weakCorpse].
  		weakList := nil]!

Item was added:
+ ----- Method: SpurMemoryManager>>allOldMarkedWeakObjectsOnWeaklingStack (in category 'weakness and ephemerality') -----
+ allOldMarkedWeakObjectsOnWeaklingStack
+ 	self allOldSpaceEntitiesDo:
+ 		[:o|
+ 		((self isWeakNonImm: o)
+ 		 and: [self isMarked: o]) ifTrue:
+ 			[(self is: o onObjStack: weaklingStack) ifFalse:
+ 				[^false]]].
+ 	^true!

Item was added:
+ ----- Method: SpurMemoryManager>>is:onObjStack: (in category 'obj stacks') -----
+ is: oop onObjStack: objStack
+ 	<inline: false>
+ 	| index nextPage |
+ 	self assert: (self numSlotsOfAny: objStack) = ObjStackPageSlots.
+ 	"There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so
+ 	  if there were 6 slots in an oop stack, full would be 2, and the last 0-rel index is 5."
+ 	index := (self fetchPointer: ObjStackTopx ofObject: objStack) + ObjStackNextx.
+ 	[index >= ObjStackFixedSlots] whileTrue:
+ 		[oop = (self fetchPointer: index ofObject: objStack) ifTrue:
+ 			[^true].
+ 		 index := index - 1].
+ 	nextPage := self fetchPointer: ObjStackNextx ofObject: objStack.
+ 	nextPage ~= 0 ifTrue:
+ 		[(self is: oop onObjStack: nextPage) ifTrue:
+ 			[^true]].
+ 	^false!

Item was changed:
  ----- Method: SpurMemoryManager>>nilUnmarkedWeaklingSlots (in category 'weakness and ephemerality') -----
  nilUnmarkedWeaklingSlots
  	"Nil the unmarked slots in the weaklings on the
  	 weakling stack, finalizing those that lost references.
  	 Finally, empty the weaklingStack."
  	<inline: false>
  	self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'nilling...'; flush].
+ 	self assert: self allOldMarkedWeakObjectsOnWeaklingStack.
  	weaklingStack = nilObj ifTrue:
  		[^self].
  	self objStack: weaklingStack from: 0 do:
  		[:weakling|
  		(self nilUnmarkedWeaklingSlotsIn: weakling) ifTrue:
  			[coInterpreter signalFinalization: weakling]].
  	self emptyObjStack: weaklingStack!

Item was changed:
  ----- Method: StackInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
  readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
  	"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
  	"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
  	"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
  
  	| headerStart headerSize headerFlags dataSize oldBaseAddr swapBytes
  	  minimumMemory bytesRead bytesToShift heapSize firstSegSize
  	  hdrEdenBytes hdrMaxExtSemTabSize hdrNumStackPages |
  	<var: #f type: #sqImageFile>
+ 	<var: #heapSize type: #usqInt>
  	<var: #dataSize type: #'size_t'>
+ 	<var: #minimumMemory type: #usqInt>
  	<var: #desiredHeapSize type: #usqInt>
  	<var: #headerStart type: #squeakFileOffsetType>
  	<var: #imageOffset type: #squeakFileOffsetType>
  
  	metaclassNumSlots := 6.	"guess Metaclass instSize"
  	classNameIndex := 6.		"guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1"
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  	headerStart := (self sqImageFilePosition: f) - BytesPerWord.  "record header start position"
  
  	headerSize			:= self getLongFromFile: f swap: swapBytes.
  	dataSize			:= self getLongFromFile: f swap: swapBytes.
  	oldBaseAddr		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  	objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B.  not used."
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	headerFlags		:= self getLongFromFile: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	extraVMMemory	:= self getLongFromFile: f swap: swapBytes.
  	hdrNumStackPages	:= self getShortFromFile: f swap: swapBytes.
  	"4 stack pages is small.  Should be able to run with as few as
  	 three. 4 should be comfortable but slow.  8 is a reasonable
  	 default.  Can be changed via vmParameterAt: 43 put: n.
  	 Can be set as a preference (Info.plist, VM.ini, command line etc).
  	 If desiredNumStackPages is already non-zero then it has been
  	 set as a preference.  Ignore (but preserve) the header's default."
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 It is used for the cog code size in Cog.  Preserve it to be polite to other VMs."
  	theUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	hdrEdenBytes		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory edenBytes: (desiredEdenBytes ~= 0
  						ifTrue: [desiredEdenBytes]
  						ifFalse:
  							[hdrEdenBytes = 0
  									ifTrue: [objectMemory defaultEdenBytes]
  									ifFalse: [hdrEdenBytes]]).
  	desiredEdenBytes := hdrEdenBytes.
  	hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
  	hdrMaxExtSemTabSize ~= 0 ifTrue:
  		[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 Preserve it to be polite to other VMs."
  	the2ndUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	firstSegSize := self getLongFromFile: f swap: swapBytes.
  	objectMemory firstSegmentSize: firstSegSize.
  	"decrease Squeak object heap to leave extra memory for the VM"
  	heapSize := desiredHeapSize
  				+ objectMemory newSpaceBytes
  				+ self interpreterAllocationReserveBytes.
  	heapSize := self reserveExtraCHeap: heapSize Bytes: extraVMMemory.
  
  	"compare memory requirements with availability".
  	minimumMemory := dataSize + objectMemory newSpaceBytes + self interpreterAllocationReserveBytes.
  	heapSize < minimumMemory ifTrue:
  		[self insufficientMemorySpecifiedError].
  
  	"allocate a contiguous block of memory for the Squeak heap"
  	objectMemory memory: (self
  								allocateMemory: heapSize
  								minimum: minimumMemory
  								imageFile: f
  								headerSize: headerSize) asUnsignedInteger.
  	objectMemory memory ifNil: [self insufficientMemoryAvailableError].
  
  	objectMemory
  		setHeapBase: objectMemory memory
  		memoryLimit: objectMemory memory + heapSize
  		endOfMemory: objectMemory memory + dataSize.
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	"compute difference between old and new memory base addresses"
  	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	^dataSize!

Item was changed:
  StackInterpreterPrimitives subclass: #StackInterpreterSimulator
+ 	instanceVariableNames: 'clone parent bootstrapping byteCount breakCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue assertVEPAES'
- 	instanceVariableNames: 'bootstrapping byteCount breakCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue assertVEPAES'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-InterpreterSimulation'!
  
  !StackInterpreterSimulator commentStamp: 'eem 9/3/2013 11:05' prior: 0!
  This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment.  It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.
  
  To see the thing actually run, you could (after backing up this image and changes), execute
  
  	(StackInterpreterSimulator new openOn: Smalltalk imageName) test
  
  	((StackInterpreterSimulator newWithOptions: #(NewspeakVM true MULTIPLEBYTECODESETS true))
  		openOn: 'ns101.image') test
  
  and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be.  We usually do this with a small and simple benchmark image.
  
  Here's an example of what Eliot uses to launch the simulator in a window.  The bottom-right window has a menu packed with useful stuff:
  
  | vm |
  vm := StackInterpreterSimulator newWithOptions: #().
  vm openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'.
  vm setBreakSelector: #&.
  vm openAsMorph; run!

Item was changed:
  ----- Method: StackInterpreterSimulator>>cloneSimulation (in category 'debug support') -----
  cloneSimulation
  	| savedDisplayView savedDisplayForm savedQuitBlock savedTranscript |
+ 	self setClone: nil.
  	savedDisplayView := displayView. displayView := nil.
  	savedDisplayForm := displayForm. displayForm = nil.
  	savedQuitBlock := quitBlock. quitBlock := nil.
  	savedTranscript := transcript. transcript := nil.
  
+ 	^[| theClone |
+ 	 Smalltalk garbageCollect.
+ 	 theClone := self veryDeepCopy.
+ 	 theClone parent: self; transcript: Transcript.
+ 	 theClone objectMemory parent: objectMemory.
+ 	 self setClone: theClone.
+ 	 objectMemory setClone: theClone objectMemory.
+ 	 theClone]
- 	[| clone window |
- 	 clone := self veryDeepCopy.
- 	 window := clone openAsMorph.
- 	 window setLabel: 'Clone of ', (savedDisplayView containingWindow label allButFirst: 'Simulation of ' size)]
  		ensure:
  			[displayView := savedDisplayView.
  			 displayForm = savedDisplayForm.
  			 quitBlock := savedQuitBlock.
  			 transcript := savedTranscript]!

Item was added:
+ ----- Method: StackInterpreterSimulator>>cloneSimulationWindow (in category 'debug support') -----
+ cloneSimulationWindow
+ 	| label |
+ 	label := 'Clone of ', (displayView containingWindow label allButFirst: 'Simulation of ' size).
+ 	^self cloneSimulation openAsMorph
+ 		setLabel: label;
+ 		yourself!

Item was added:
+ ----- Method: StackInterpreterSimulator>>getClone (in category 'accessing') -----
+ getClone
+ 
+ 	^ clone!

Item was added:
+ ----- Method: StackInterpreterSimulator>>parent (in category 'accessing') -----
+ parent
+ 
+ 	^ parent!

Item was added:
+ ----- Method: StackInterpreterSimulator>>parent: (in category 'accessing') -----
+ parent: anObject
+ 
+ 	parent := anObject!

Item was added:
+ ----- Method: StackInterpreterSimulator>>setClone: (in category 'accessing') -----
+ setClone: aSpurMMSimulator
+ 
+ 	clone := aSpurMMSimulator!

Item was changed:
  ----- Method: StackInterpreterSimulator>>utilitiesMenu: (in category 'UI') -----
  utilitiesMenu: aMenuMorph
  	aMenuMorph
  		add: 'toggle transcript' action: #toggleTranscript;
+ 		add: 'clone VM' action: #cloneSimulationWindow;
- 		add: 'clone VM' action: #cloneSimulation;
  		addLine;
  		add: 'print ext head frame' action: #printExternalHeadFrame;
  		add: 'print int head frame' action: #printHeadFrame;
  		add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
  		add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
  		add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
  		add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
  		add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
  		add: 'print call stack' action: #printCallStack;
  		add: 'print stack call stack' action: #printStackCallStack;
  		add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
  		add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
  		add: 'print all stacks' action: #printAllStacks;
  		add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
  											self writeBackHeadFramePointers];
  		add: 'print prim trace log' action: #dumpPrimTraceLog;
  		addLine;
  		add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
  		add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
  		addLine;
  		add: 'inspect object memory' target: objectMemory action: #inspect;
  		add: 'inspect interpreter' action: #inspect;
  		addLine;
  		add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
  											s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
  		add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
  											s notEmpty ifTrue: [self setBreakSelector: s]];
  		add: 'turn valid exec ptrs assert o', (assertVEPAES ifTrue: ['ff'] ifFalse: ['n']) action: [assertVEPAES := assertVEPAES not];
  		add: (printSends
  				ifTrue: ['no print sends']
  				ifFalse: ['print sends'])
  			action: [self ensureDebugAtEachStepBlock.
  					printSends := printSends not];
  		"currently printReturns does nothing"
  		"add: (printReturns
  				ifTrue: ['no print returns']
  				ifFalse: ['print returns'])
  			action: [self ensureDebugAtEachStepBlock.
  					printReturns := printReturns not];"
  		add: (printBytecodeAtEachStep
  				ifTrue: ['no print bytecode each bytecode']
  				ifFalse: ['print bytecode each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printBytecodeAtEachStep := printBytecodeAtEachStep not];
  		add: (printFrameAtEachStep
  				ifTrue: ['no print frame each bytecode']
  				ifFalse: ['print frame each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printFrameAtEachStep := printFrameAtEachStep not].
  	^aMenuMorph!



More information about the Vm-dev mailing list