[Vm-dev] VM Maker: VMMaker.oscog-cb.1802.mcz

[commits at source.squeak.org]

ClementBera uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-cb.1802.mcz

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

Name: VMMaker.oscog-cb.1802
Author: cb
Time: 14 April 2016, 10:10:19.791967 am
UUID: dfba380b-78c8-4336-82ff-da433937a972
Ancestors: VMMaker.oscog-eem.1801

Minor changes to the simulator to ease simulation form a Pharo image.

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

Item was changed:
  ----- Method: CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate (in category 'initialization') -----
  ensureMultiThreadingOverridesAreUpToDate
  	"Make sure the CoInterpreterMT switch methods are implemented.  These methods select
  	 between CoInterpreterMT's implementation or CoInterpreter's implementation depending
  	 on cogThreadManager being non-nil or nil respectively.  i.e. they allow us to use this one
  	 simulator class to simulate for both CoInterpreterMT and CoInterpreter."
  	| thisClass me mtInterpreterClass |
+ 	self cppIf: COGMTVM ifTrue: [  ] ifFalse: [ ^self ].
  	thisClass := thisContext methodClass.
  	mtInterpreterClass := thisClass superclass.
  	me := thisClass name, '>>', thisContext method selector.
  	"We want override switches for everything implemented by CoInterpreter
  	 and CoInterpreterMT that is either not implemented by CogVMSimulator
  	 or already implemented by CogVMSimulator as an override switch."
  	(mtInterpreterClass selectors select:
  		[:sel|
  		(mtInterpreterClass superclass whichClassIncludesSelector: sel) notNil
  		and: [(thisClass organization categoryOfElement: sel)
  				ifNil: [true]
  				ifNotNil: [:cat| cat == #'multi-threading simulation switch']]])
  		do: [:sel| | argNames desiredSource |
  			argNames := Parser new
  							initPattern: (mtInterpreterClass sourceCodeAt: sel)
  							return: [:pattern| pattern second].
  			desiredSource := String streamContents:
  								[:str|
  								argNames isEmpty
  									ifTrue: [str nextPutAll: sel]
  									ifFalse:
  										[sel keywords with: argNames do:
  											[:kw :arg| str nextPutAll: kw; space; nextPutAll: arg; space].
  										 str skip: -1].
  								str
  									crtab;
  									nextPutAll: '"This method includes or excludes ', mtInterpreterClass name, ' methods as required.';
  									crtab;
  									nextPutAll: ' Auto-generated by ', me, '"';
  									cr;
  									crtab;
  									nextPutAll: '^self perform: ';
  									store: sel;
  									crtab: 2;
  									nextPutAll: 'withArguments: {'.
  								argNames
  									do: [:arg| str nextPutAll: arg]
  									separatedBy: [str nextPut: $.; space].
  								str
  									nextPut: $};
  									crtab: 2;
  									nextPutAll: 'inSuperclass: (cogThreadManager ifNil: [';
  									print: mtInterpreterClass superclass;
  									nextPutAll: '] ifNotNil: [';
  									print: mtInterpreterClass;
  									nextPutAll: '])'].
  			desiredSource ~= (thisClass sourceCodeAt: sel ifAbsent: ['']) asString ifTrue:
  				[((thisClass includesSelector: sel)
  				  and: [(thisClass compiledMethodAt: sel) messages includesAnyOf: #(halt halt:)])
  					ifTrue: [self transcript cr; nextPutAll: 'WARNING, because of halts, not generating '; nextPutAll: desiredSource; cr; flush]
  					ifFalse: [thisClass compile: desiredSource classified: #'multi-threading simulation switch']]].
  	"Make sure obsolete CoInterpreterMT switch methods are deleted."
  	((thisContext methodClass organization listAtCategoryNamed: #'multi-threading simulation switch') select:
  		[:sel| (mtInterpreterClass whichClassIncludesSelector: sel) isNil]) do:
  			[:sel| thisClass removeSelector: sel]!

Item was changed:
  ----- Method: CogVMSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
  primitiveDirectoryEntry
  	| name pathName arrayNilOrSymbol result |
  	name := self stringOf: self stackTop.
  	pathName := self stringOf: (self stackValue: 1).
  	
+ 	"temporary work-around to make it work in Pharo..."
+ 	self cppIf: PharoVM ifTrue: [ pathName := Smalltalk imagePath ].
+ 	
  	self successful ifFalse:
  		[^self primitiveFail].
  
  	arrayNilOrSymbol := FileDirectory default primLookupEntryIn: pathName name: name.
  	arrayNilOrSymbol ifNil:
  		[self pop: 3 thenPush: objectMemory nilObject.
  		 ^self].
  	arrayNilOrSymbol isArray ifFalse:
+ 		["arrayNilOrSymbol ~~ #primFailed ifTrue:
+ 			[self halt]. "
+ 		Transcript show: name, ' NOT FOUND'.
- 		[arrayNilOrSymbol ~~ #primFailed ifTrue:
- 			[self halt].
  		 ^self primitiveFail].
  
  	result := PharoVM 
  		ifTrue:
  			[self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
  				createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
  				isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5)
  				posixPermissions: (arrayNilOrSymbol at: 6) isSymlink: (arrayNilOrSymbol at: 7) ]
  		ifFalse:
  			[self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
  				createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
  				isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) ].
  	self pop: 3 thenPush: result!

Item was changed:
  ----- Method: StackInterpreterSimulator>>ioGetNextEvent: (in category 'I/O primitives') -----
  ioGetNextEvent: evtBuf
  	| evt |
  	"SimulatorMorphicModel browse"
  	eventQueue ifNil:
  		[^self primitiveFail].
  	eventQueue isEmpty ifFalse:
  		[evt :=  eventQueue next.
  		 1 to: evtBuf size do:
+ 			[:i| (evt at: i) ifNotNil: [:val| evtBuf at: (i - 1) put: val asInteger]]]!
- 			[:i| (evt at: i) ifNotNil: [:val| evtBuf at: (i - 1) put: val]]]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
  primitiveDirectoryEntry
  	| name pathName arrayNilOrSymbol result |
  	name := self stringOf: self stackTop.
  	pathName := self stringOf: (self stackValue: 1).
  	
+ 	"temporary work-around to make it work in Pharo..."
+ 	self cppIf: PharoVM ifTrue: [ pathName := Smalltalk imagePath ].
+ 	
  	self successful ifFalse:
  		[^self primitiveFail].
  
  	arrayNilOrSymbol := FileDirectory default primLookupEntryIn: pathName name: name.
  	arrayNilOrSymbol ifNil:
  		[self pop: 3 thenPush: objectMemory nilObject.
  		 ^self].
  	arrayNilOrSymbol isArray ifFalse:
+ 		["arrayNilOrSymbol ~~ #primFailed ifTrue:
+ 			[self halt]. "
+ 		Transcript show: name , ' NOT FOUND'.
- 		[arrayNilOrSymbol ~~ #primFailed ifTrue:
- 			[self halt].
  		 ^self primitiveFail].
  
  	result := PharoVM 
  		ifTrue:
  			[self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
  				createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
  				isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5)
  				posixPermissions: (arrayNilOrSymbol at: 6) isSymlink: (arrayNilOrSymbol at: 7) ]
  		ifFalse:
  			[self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
  				createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
  				isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) ].
  	self pop: 3 thenPush: result!