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

commits at source.squeak.org commits at source.squeak.org
Mon Oct 29 22:44:43 UTC 2018 

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

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

Name: VMMaker.oscog-eem.2477
Author: eem
Time: 29 October 2018, 3:43:53.470679 pm
UUID: d3baf73f-464f-4d2a-a17e-d57c5a7e595d
Ancestors: VMMaker.oscog-eem.2476

Plugins:
Fix primDigitCompare for SmallIntegers.  The old code compared the values of the receiver and argument, not their magnitudes, if both were SmallIntegers.

Simplify the FilePlugin. removing an unnecessary indirection around dir_Delimitor, and eliminating an unnecessary cCode:inSmalltalk:.

Simulator:
Fix a regression with FilePlugin loading due to the simplifications to simulated plugin loading introduced in VMMaker.oscog-eem.2476.  mappedPluginEntries must be extended, not assigned to.

Disable simulation for ClipboardExtendedPlugin.  This would be a good exercise for someone who wanted to try writing a plugin simulation themselves, hint, hint.

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

Item was added:
+ ----- Method: ClipboardExtendedPlugin class>>simulatorClass (in category 'simulation') -----
+ simulatorClass
+ 	"This should be easy to simulate, but I'm short of time.  Feel free to have a go, following e.g. the pattern in JPEGReadWriter2Plugin."
+ 	^nil!

Item was changed:
  ----- Method: CogVMSimulator>>ioLoadFunction:From: (in category 'plugin support') -----
  ioLoadFunction: functionString From: pluginString
  	"Load and return the requested function from a module"
  	| firstTime plugin fnSymbol |
  	firstTime := false.
  	fnSymbol := functionString asSymbol.
  	transcript
  		cr;
  		show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
+ 				(pluginString isEmpty ifTrue: ['vm'] ifFalse: [pluginString]).
- 				(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
  	(breakSelector notNil
  	 and: [(pluginString size = breakSelector size
  			and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0])
  		or: [functionString size = breakSelector size
  			and: [(self strncmp: functionString _: breakSelector _: functionString size) = 0]]]) ifTrue:
  		[self halt: pluginString, '>>', functionString].
  	plugin := pluginList 
+ 				detect: [:any| any key = pluginString asString]
- 				detect:[:any| any key = pluginString asString]
  				ifNone:
  					[firstTime := true.
+ 					 self loadNewPlugin: pluginString].
- 					self loadNewPlugin: pluginString].
  	plugin ifNil:
+ 		[firstTime ifTrue: [transcript cr; show: '... FAILED; no plugin found'].
- 		[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  		 ^0].
  	plugin := plugin value.
+ 	mappedPluginEntries withIndexDo:
- 	mappedPluginEntries doWithIndex:
  		[:pluginAndName :index|
  		((pluginAndName at: 1) == plugin 
  		and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
  			[^index]].
  	(plugin respondsTo: fnSymbol) ifFalse:
+ 		[firstTime ifTrue: [transcript cr; show: '... FAILED; primitive not in plugin'].
- 		[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  		 ^0].
+ 	mappedPluginEntries addLast: { plugin. fnSymbol. [plugin perform: fnSymbol. self]}.
- 	mappedPluginEntries addLast: (Array
- 									with: plugin
- 									with: fnSymbol
- 									with: [plugin perform: fnSymbol. self]).
  	transcript show: ' ... okay'.
+ 	^mappedPluginEntries size!
- 	^ mappedPluginEntries size!

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]).
- 				(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
  	(breakSelector notNil
  	 and: [(pluginString size = breakSelector size
  			and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0])
  		or: [functionString size = breakSelector size
  			and: [(self strncmp: functionString _: breakSelector _: functionString size) = 0]]]) ifTrue:
  		[self halt: pluginString, '>>', functionString].
  	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'].
- 		[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  		 ^0].
  	plugin := plugin value.
+ 	mappedPluginEntries withIndexDo:
- 	mappedPluginEntries doWithIndex:
  		[:pluginAndName :index|
  		 ((pluginAndName at: 1) == plugin 
  		  and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
  			[firstTime ifTrue: [transcript show: ' ... okay'].
  			 accessorDepthPtr at: 0 put: (pluginAndName at: 4).
  			 ^index]].
+ 	firstTime ifTrue: [transcript cr; show: '... FAILED; primitive not in plugin'].
- 	firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  	^0!

Item was removed:
- ----- Method: FilePlugin>>asciiDirectoryDelimiter (in category 'directory primitives') -----
- asciiDirectoryDelimiter
- 	^ self
- 		cCode: 'dir_Delimitor()'
- 		inSmalltalk:
- 			[(Smalltalk classNamed: #FileSystem)
- 				ifNotNil: [:fileSystem| fileSystem disk delimiter asciiValue]
- 				ifNil: [FileDirectory pathNameDelimiter asciiValue]]!

Item was added:
+ ----- Method: FilePlugin>>dir_Delimitor (in category 'directory primitives') -----
+ dir_Delimitor
+ 	<doNotGenerate>
+ 	^(Smalltalk classNamed: #FileSystem)
+ 		ifNotNil: [:fileSystem| fileSystem disk delimiter asInteger]
+ 		ifNil: [FileDirectory pathNameDelimiter asInteger]!

Item was changed:
  ----- Method: FilePlugin>>initialiseModule (in category 'initialize-release') -----
  initialiseModule
  	<export: true>
  	sCCPfn := interpreterProxy ioLoadFunction: 'secCanCreatePathOfSize' From: 'SecurityPlugin'.
  	sCDPfn := interpreterProxy ioLoadFunction: 'secCanDeletePathOfSize' From: 'SecurityPlugin'.
  	sCGFTfn := interpreterProxy ioLoadFunction: 'secCanGetFileTypeOfSize' From: 'SecurityPlugin'.
  	sCLPfn := interpreterProxy ioLoadFunction: 'secCanListPathOfSize' From: 'SecurityPlugin'.
  	sCSFTfn := interpreterProxy ioLoadFunction: 'secCanSetFileTypeOfSize' From: 'SecurityPlugin'.
  	sDFAfn := interpreterProxy ioLoadFunction: 'secDisableFileAccess' From: 'SecurityPlugin'.
  	sCDFfn := interpreterProxy ioLoadFunction: 'secCanDeleteFileOfSize' From: 'SecurityPlugin'.
  	sCOFfn := interpreterProxy ioLoadFunction: 'secCanOpenFileOfSizeWritable' From: 'SecurityPlugin'.
  	sCRFfn := interpreterProxy ioLoadFunction: 'secCanRenameFileOfSize' From: 'SecurityPlugin'.
  	sHFAfn := interpreterProxy ioLoadFunction: 'secHasFileAccess' From: 'SecurityPlugin'.
+ 	^self sqFileInit!
- 	^self cCode: [self sqFileInit] inSmalltalk: [true]!

Item was changed:
  ----- Method: FilePlugin>>primitiveDirectoryDelimitor (in category 'directory primitives') -----
  primitiveDirectoryDelimitor
- 	| ascii |
  	<export: true>
- 	ascii := self asciiDirectoryDelimiter.
  	interpreterProxy minorVersion >= 13
  		ifTrue:
  			[interpreterProxy
  				pop: 1
+ 				thenPush: (interpreterProxy characterObjectOf: self dir_Delimitor)]
- 				thenPush: (interpreterProxy characterObjectOf: ascii)]
  		ifFalse:
+ 			[| ascii |
+ 			 ascii := self asciiDirectoryDelimiter.
+ 			 (ascii >= 0 and: [ascii <= 255])
- 			[(ascii >= 0 and: [ascii <= 255])
  				ifTrue:
  					[interpreterProxy
  						pop: 1
  						thenPush: (interpreterProxy
  										fetchPointer: ascii
  										ofObject: interpreterProxy characterTable)]
  				ifFalse:
  					[interpreterProxy primitiveFail]]!

Item was removed:
- ----- Method: FilePluginSimulator>>initialiseModule (in category 'initialize-release') -----
- initialiseModule
- 	"See FilePluginSimulator>>sqFileStdioHandlesInto:"
- 	(openFiles := Dictionary new)
- 		at: 0 put: (FakeStdinStream for: interpreterProxy interpreter); "stdin"
- 		at: 1 put: interpreterProxy interpreter transcript; "stdout"
- 		at: 2 put: interpreterProxy interpreter transcript. "stderr"
- 	states := IdentityDictionary new.
- 	maxOpenFiles := VMClass initializationOptions at: #MaxFileDescriptors ifAbsent: [1024].
- 	^super initialiseModule!

Item was added:
+ ----- Method: FilePluginSimulator>>sqFileInit (in category 'initialize-release') -----
+ sqFileInit
+ 	"See FilePluginSimulator>>sqFileStdioHandlesInto:"
+ 	(openFiles := Dictionary new)
+ 		at: 0 put: (FakeStdinStream for: interpreterProxy interpreter); "stdin"
+ 		at: 1 put: interpreterProxy interpreter transcript; "stdout"
+ 		at: 2 put: interpreterProxy interpreter transcript. "stderr"
+ 	states := IdentityDictionary new.
+ 	maxOpenFiles := VMClass initializationOptions at: #MaxFileDescriptors ifAbsent: [1024].
+ 	^true!

Item was changed:
  ----- Method: LargeIntegersPlugin>>primDigitCompare: (in category 'Integer primitives') -----
  primDigitCompare: secondInteger 
+ 	"Compare the magnitude of self with that of arg.   
+ 	 Answer a code of 1, 0, -1 for self >, = , < arg"	| firstVal secondVal firstInteger |
- 	| firstVal secondVal firstInteger |
  	self debugCode: [self msg: 'primDigitCompare: secondInteger'].
  	firstInteger := self
+ 					primitive: 'primDigitCompare'
+ 					parameters: #(#Integer )
+ 					receiver: #Integer.
+ 	"shortcut: aSmallInteger has to be smaller in Magnitude than aLargeInteger"
+ 	(interpreterProxy isIntegerObject: firstInteger) ifTrue:
+ 		[(interpreterProxy isIntegerObject: secondInteger) ifTrue:
+ 			[firstVal := interpreterProxy integerValueOf: firstInteger.
+ 			 secondVal := interpreterProxy integerValueOf: secondInteger.
+ 			 "Compute their magnitudes.  Since SmallIntegers are tagged they have
+ 			  fewer bits than an integer on the platform; therefore in computing their
+ 			  magnitude they cannot overflow."
+ 			 firstVal < 0 ifTrue: [firstVal := 0 - firstVal].
+ 			 secondVal < 0 ifTrue: [secondVal := 0 - secondVal].
+ 			 ^firstVal = secondVal
+ 				ifTrue: [0 asOop: SmallInteger]
+ 				ifFalse:
+ 					[firstVal < secondVal
+ 						ifTrue: [-1 asOop: SmallInteger]
+ 						ifFalse: [1 asOop: SmallInteger]]].
+ 			^-1 asOop: SmallInteger]. "first < second"
+ 	(interpreterProxy isIntegerObject: secondInteger) ifTrue:
+ 		[^1 asOop: SmallInteger]. "first > second"
+ 	^ self digitCompareLarge: firstInteger with: secondInteger!
- 				primitive: 'primDigitCompare'
- 				parameters: #(#Integer )
- 				receiver: #Integer.
- 	"shortcut: aSmallInteger has to be smaller in Magnitude as aLargeInteger"
- 	(interpreterProxy isIntegerObject: firstInteger)
- 		ifTrue: ["first"
- 			(interpreterProxy isIntegerObject: secondInteger)
- 				ifTrue: ["second"
- 					(firstVal := interpreterProxy integerValueOf: firstInteger) > (secondVal := interpreterProxy integerValueOf: secondInteger)
- 						ifTrue: [^ 1 asOop: SmallInteger"first > second"]
- 						ifFalse: [firstVal < secondVal
- 								ifTrue: [^ -1 asOop: SmallInteger"first < second"]
- 								ifFalse: [^ 0 asOop: SmallInteger"first = second"]]]
- 				ifFalse: ["SECOND"
- 					^ -1 asOop: SmallInteger"first < SECOND"]]
- 		ifFalse: ["FIRST"
- 			(interpreterProxy isIntegerObject: secondInteger)
- 				ifTrue: ["second"
- 					^ 1 asOop: SmallInteger"FIRST > second"]
- 				ifFalse: ["SECOND"
- 					^ self digitCompareLarge: firstInteger with: secondInteger]]!

Item was changed:
  ----- Method: StackInterpreter>>tryLoadNewPlugin:pluginEntries: (in category 'primitive support') -----
  tryLoadNewPlugin: pluginString pluginEntries: pluginEntries
  	"Load the plugin and if on Spur, populate pluginEntries with the prmitives in the plugin."
  	<doNotGenerate>
  	| plugin realPluginClass plugins |
  	self transcript cr; show: 'Looking for module ', pluginString.
  	pluginString isEmpty
  		ifTrue:
  			[plugin := self]
  		ifFalse:
  			[plugins := InterpreterPlugin allSubclasses select:
  							[:psc|
  							 psc moduleName asString = pluginString asString
  							 and: [psc shouldBeTranslated]].
  			 plugins isEmpty ifTrue: [self transcript show: ' ... not found'. ^nil].
  			 plugins size > 1 ifTrue: [^self error: 'This won''t work...'].
  			 "plugins size > 1 ifTrue:
  				[self transcript show: '...multiple plugin classes; choosing ', plugins last name]."
  			 realPluginClass := plugins anyOne. "hopefully lowest in the hierarchy..."
  			 plugin := realPluginClass simulatorForInterpreterInterface: objectMemory.
+ 			 plugin ifNil: [self transcript show: ' ... no simulator class; cannot simulate'. ^nil].
  			 (plugin respondsTo: #initialiseModule) ifTrue:
  				[plugin initialiseModule ifFalse:
  					[self transcript show: ' ... initialiser failed'. ^nil]]]. "module initialiser failed"
  	self transcript show: ' ... loaded'.
  	objectMemory hasSpurMemoryManagerAPI ifTrue:
  		[| realPlugin cg |
  		 self transcript show: '...computing accessor depths'.
  		 plugin class isPluginClass
  			ifTrue:
  				[realPlugin := (plugin isSmartSyntaxPluginSimulator
  									ifTrue: [realPluginClass]
  									ifFalse: [plugin class])
  								 withAllSuperclasses detect: [:class| class shouldBeTranslated].
  				 cg := realPlugin buildCodeGenerator]
  			ifFalse:
  				[cg := self codeGeneratorToComputeAccessorDepth.
  				 primitiveTable withIndexDo:
  					[:prim :index| | depth |
  					 prim isSymbol ifTrue:
  						[depth := cg accessorDepthForSelector: prim.
  						 self assert: (depth isInteger or: [depth isNil and: [(plugin class whichClassIncludesSelector: prim) isNil]]).
  						 primitiveAccessorDepthTable at: index - 1 put: depth]]].
  		 cg exportedPrimitiveNames do:
  			[:primName| | fnSymbol |
  			 fnSymbol := primName asSymbol.
  			 pluginEntries addLast: {plugin.
  									fnSymbol.
  									[plugin perform: fnSymbol. self].
  									cg accessorDepthForSelector: fnSymbol}].
  		 self transcript show: '...done'].
  	^pluginString asString -> plugin!

Item was changed:
  ----- Method: StackInterpreterSimulator>>ioLoadFunction:From: (in category 'plugin support') -----
  ioLoadFunction: functionString From: pluginString
  	"Load and return the requested function from a module"
  	| firstTime plugin fnSymbol |
  	firstTime := false.
  	fnSymbol := functionString asSymbol.
  	transcript
  		cr;
  		show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
+ 				(pluginString isEmpty ifTrue: ['vm'] ifFalse: [pluginString]).
- 				(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
  	(breakSelector notNil
  	 and: [(pluginString size = breakSelector size
  			and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0])
  		or: [functionString size = breakSelector size
  			and: [(self strncmp: functionString _: breakSelector _: functionString size) = 0]]]) ifTrue:
  		[self halt: pluginString, '>>', functionString].
  	plugin := pluginList 
+ 				detect: [:any| any key = pluginString asString]
+ 				ifNone:
+ 					[firstTime := true.
+ 					 self loadNewPlugin: pluginString].
+ 	plugin ifNil:
+ 		[firstTime ifTrue: [transcript cr; show: '... FAILED; no plugin found'].
+ 		 ^0].
- 				detect:[:any| any key = pluginString asString]
- 				ifNone:[firstTime := true.
- 						self loadNewPlugin: pluginString].
- 	plugin ifNil:[transcript show: 'Failed ... no plugin found'. ^ 0].
  	plugin := plugin value.
+ 	mappedPluginEntries withIndexDo:
+ 		[:pluginAndName :index|
- 	mappedPluginEntries doWithIndex:[:pluginAndName :index|
  		((pluginAndName at: 1) == plugin 
+ 		and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
+ 			[^index]].
- 			and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
- 				[firstTime ifTrue: [transcript show:' ... okay'. ^ index]]].
  	(plugin respondsTo: fnSymbol) ifFalse:
+ 		[firstTime ifTrue: [transcript cr; show: '... FAILED; primitive not in plugin'].
+ 		 ^0].
+ 	mappedPluginEntries addLast: { plugin. fnSymbol }.
- 		[transcript show:'Failed ... primitive not in plugin'. ^ 0].
- 	mappedPluginEntries := mappedPluginEntries copyWith: (Array with: plugin with: fnSymbol).
  	transcript show: ' ... okay'.
+ 	^mappedPluginEntries size!
- 	^ mappedPluginEntries size!

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]).
- 				(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
  	(breakSelector notNil
  	 and: [(pluginString size = breakSelector size
  			and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0])
  		or: [functionString size = breakSelector size
  			and: [(self strncmp: functionString _: breakSelector _: functionString size) = 0]]]) ifTrue:
  		[self halt: pluginString, '>>', functionString].
  	plugin := pluginList 
  				detect: [:any| any key = pluginString asString]
  				ifNone:
  					[firstTime := true.
  					 self loadNewPlugin: pluginString].
  	plugin ifNil:
+ 		[firstTime ifTrue: [transcript show: '... FAILED; no plugin found'].
- 		[firstTime ifTrue: [transcript show: 'Failed ... primitive not in plugin'].
  		 ^0].
  	plugin := plugin value.
+ 	mappedPluginEntries withIndexDo:
- 	mappedPluginEntries doWithIndex:
  		[:pluginAndName :index|
  		 ((pluginAndName at: 1) == plugin 
  		  and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
  			[firstTime ifTrue: [transcript show: ' ... okay'].
  			 accessorDepthPtr at: 0 put: (pluginAndName at: 4).
  			 ^index]].
+ 	firstTime ifTrue: [transcript show: '... FAILED; primitive not in plugin'].
- 	firstTime ifTrue: [transcript show: 'Failed ... primitive not in plugin'].
  	^0!

More information about the Vm-dev mailing list