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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.703
Author: eem
Time: 4 May 2014, 5:22:13.476 pm
UUID: 72bcfdab-bf50-4e10-a4d7-81c9cd88eccd
Ancestors: VMMaker.oscog-eem.702

Fix stack printing when frameCallerContext ref is forwarded.

Simulator:
Fix breakpointing in ioLoadFunction:From:AccessorDepthInto:

Allow breakpointing on plugin load.

Fix str:n:cmp:

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

Item was changed:
  ----- Method: CogVMSimulator>>ioLoadFunction:From:AccessorDepthInto: (in category 'plugin support') -----
  ioLoadFunction: functionString From: pluginString AccessorDepthInto: accessorDepthPtr
  	"Load and return the requested function from a module.
  	 Assign the accessor depth through accessorDepthPtr.
  	 N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
  	| firstTime plugin fnSymbol |
  	firstTime := false.
  	fnSymbol := functionString asSymbol.
  	transcript
  		cr;
  		show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
  				(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
+ 	(self str: functionString n: breakSelector cmp: functionString size) = 0 ifTrue:
+ 		[self halt: functionString].
- 	functionString = breakSelector ifTrue: [self halt: breakSelector].
  	plugin := pluginList 
  				detect: [:any| any key = pluginString asString]
  				ifNone:
  					[firstTime := true.
  					 self loadNewPlugin: pluginString].
  	plugin ifNil:
  		[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  		 ^0].
  	plugin := plugin value.
  	mappedPluginEntries doWithIndex:
  		[:pluginAndName :index|
  		 ((pluginAndName at: 1) == plugin 
  		  and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
  			[firstTime ifTrue: [transcript show: ' ... okay'; cr].
  			 accessorDepthPtr at: 0 put: (pluginAndName at: 4).
  			 ^index]].
  	firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  	^0!

Item was changed:
  ----- Method: CogVMSimulator>>loadNewPlugin: (in category 'plugin support') -----
  loadNewPlugin: pluginString
+ 	(self str: pluginString n: breakSelector cmp: pluginString size) = 0 ifTrue:
+ 		[self halt: pluginString].
  	^(self tryLoadNewPlugin: pluginString pluginEntries: mappedPluginEntries) ifNotNil:
  		[:entry|
  		 pluginList := pluginList copyWith: entry.
  		 entry]!

Item was changed:
  ----- Method: SpurSegmentManager>>prepareForSnapshot (in category 'snapshot') -----
  prepareForSnapshot
  	"shorten all segments by any trailing free space."
  	<inline: false>
  	<var: #seg type: #'SpurSegmentInfo *'>
  	0 to: numSegments - 1 do:
  		[:i|
  		 (segments at: i)
  			savedSegSize: (segments at: i) segSize;
  			lastFreeObject: nil].
  
  	"Ideally finding the lastFreeObject of each segment would be
  	 done in some linear pass through the heap.  But for now KISS."
  	manager freeTreeNodesDo:
  		[:freeChunk| | node next seg |
  		 node := freeChunk.
  		 [node ~= 0] whileTrue:
  			[next := manager objectAfter: node limit: manager endOfMemory.
  			 (manager isSegmentBridge: next)
  				ifTrue:
  					[seg := self segmentContainingObj: node.
  					 seg lastFreeObject: node.
  					 node := 0]
  				ifFalse:
+ 					[node := manager
+ 								fetchPointer: manager freeChunkNextIndex
- 					[node := self fetchPointer: self freeChunkNextIndex
  								ofFreeChunk: node]].
  		 freeChunk].
  
  	0 to: numSegments - 1 do:
  		[:i|
  		 (segments at: i) lastFreeObject ifNotNil:
  			[:freeChunk|
  			manager detachFreeObject: freeChunk.
  			(segments at: i)
  				segSize: (manager startOfObject: freeChunk)
  						+ manager bridgeSize
  						- (segments at: i) segStart.
  			self bridgeFrom: (self addressOf: (segments at: i))
  				to: (i < (numSegments - 1) ifTrue: [self addressOf: (segments at: i + 1)])]].
  
  	"perhaps this should read
  		manager setEndOfMemory: 0; assimilateNewSegment: (segments at: numSegments - 1)"
  	manager setEndOfMemory: (segments at: numSegments - 1) segLimit - manager bridgeSize!

Item was changed:
  ----- Method: StackInterpreter>>printCallStackOf:currentFP: (in category 'debug printing') -----
  printCallStackOf: aContext currentFP: currFP
  	| ctxt theFP thePage |
  	<inline: false>
  	<var: #currFP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	ctxt := aContext.
  	[ctxt = objectMemory nilObject] whileFalse:
  		[(self isMarriedOrWidowedContext: ctxt)
  			ifFalse:
  				[self shortPrintContext: ctxt.
  				 ctxt := objectMemory fetchPointer: SenderIndex ofObject: ctxt]
  			ifTrue:
  				[theFP := self frameOfMarriedContext: ctxt.
  				 (self checkIsStillMarriedContext: ctxt currentFP: currFP)
  					ifTrue:
  						[thePage := stackPages stackPageFor: theFP.
  						 (stackPages isFree: thePage) ifTrue:
  							[self printHexPtr: theFP; print: ' is on a free page?!!'; cr.
  							 ^nil].
  						 self shortPrintFrameAndCallers: theFP.
  						 theFP := thePage baseFP.
+ 						 ctxt := self frameCallerContext: theFP.
+ 						 (objectMemory isForwarded: ctxt) ifTrue:
+ 							[ctxt := objectMemory followForwarded: ctxt]]
- 						 ctxt := self frameCallerContext: theFP]
  					ifFalse: [self print: 'widowed caller frame '; printHexPtr: theFP; cr.
  							^nil]]]!

Item was changed:
  ----- Method: StackInterpreter>>shortReversePrintFrameAndCallers: (in category 'debug printing') -----
  shortReversePrintFrameAndCallers: aFramePointer
+ 	| theFP callerFP caller |
- 	| theFP callerFP |
  	<inline: false>
  	<var: #aFramePointer type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	aFramePointer = 0 ifTrue:
  		[^objectMemory nilObject].
  	theFP := aFramePointer.
  	[self shortPrintFrame: theFP.
  	 callerFP := self frameCallerFP: theFP.
  	 callerFP ~= 0] whileTrue:
  		[theFP := callerFP].
+ 	caller := self frameCallerContext: theFP.
+ 	(objectMemory isForwarded: caller) ifTrue:
+ 		[caller := objectMemory followForwarded: caller].
+ 	^caller!
- 	^self frameCallerContext: theFP!

Item was changed:
  ----- Method: StackInterpreterSimulator>>ioLoadFunction:From:AccessorDepthInto: (in category 'plugin support') -----
  ioLoadFunction: functionString From: pluginString AccessorDepthInto: accessorDepthPtr
  	"Load and return the requested function from a module.
  	 Assign the accessor depth through accessorDepthPtr.
  	 N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
  	| firstTime plugin fnSymbol |
  	firstTime := false.
  	fnSymbol := functionString asSymbol.
  	transcript
  		cr;
  		show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
  				(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
+ 	breakSelector ifNotNil:
+ 		[(self str: functionString n: breakSelector cmp: functionString size) = 0 ifTrue:
+ 			[self halt: functionString]].
- 	functionString = breakSelector ifTrue: [self halt: breakSelector].
  	plugin := pluginList 
  				detect: [:any| any key = pluginString asString]
  				ifNone:
  					[firstTime := true.
  					 self loadNewPlugin: pluginString].
  	plugin ifNil:
  		[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  		 ^0].
  	plugin := plugin value.
+ 	"mappedPluginEntries select: [:tuple| tuple first = plugin] an OrderedCollection({an UnixOSProcessPlugin . #getModuleName . [closure] in [] in StackInterpreterSimulatorLSB(StackInterpreter)>>tryLoadNewPlugin:pluginEntries: . nil} {an UnixOSProcessPlugin . #setInterpreter . [closure] in [] in StackInterpreterSimulatorLSB(StackInterpreter)>>tryLoadNewPlugin:pluginEntries: . nil})"
  	mappedPluginEntries doWithIndex:
  		[:pluginAndName :index|
  		 ((pluginAndName at: 1) == plugin 
  		  and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
  			[firstTime ifTrue: [transcript show: ' ... okay'; cr].
  			 accessorDepthPtr at: 0 put: (pluginAndName at: 4).
  			 ^index]].
  	firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  	^0!

Item was changed:
  ----- Method: StackInterpreterSimulator>>loadNewPlugin: (in category 'plugin support') -----
  loadNewPlugin: pluginString
+ 	breakSelector ifNotNil:
+ 		[(self str: pluginString n: breakSelector cmp: pluginString size) = 0 ifTrue:
+ 			[self halt: pluginString]].
  	^(self tryLoadNewPlugin: pluginString pluginEntries: mappedPluginEntries) ifNotNil:
  		[:entry|
  		 pluginList := pluginList copyWith: entry.
  		 entry]!

Item was changed:
  ----- Method: VMClass>>str:n:cmp: (in category 'C library simulation') -----
  str: aString n: bString cmp: n
  	<doNotGenerate>
  	"implementation of strncmp(3)"
  	bString isString ifTrue:
+ 		[1 to: n do:
+ 			[:i|
+ 			 (aString at: i) asCharacter ~= (bString at: i) ifTrue:
+ 				[^i]].
+ 		 ^0].
- 		[^(aString first: (n min: aString size)) ~= (bString first: (n min: bString size))].
  	1 to: n do:
  		[:i| | v |
  		v := (aString at: i) asInteger - (self byteAt: bString + i - 1).
  		v ~= 0 ifTrue: [^v]].
  	^0!