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

commits at source.squeak.org commits at source.squeak.org
Mon Jul 18 20:00:23 UTC 2022


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

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

Name: VMMaker.oscog-eem.3213
Author: eem
Time: 18 July 2022, 1:00:08.438425 pm
UUID: 5671cad5-6c4d-4e4c-ab40-d0ecab9f1ed9
Ancestors: VMMaker.oscog-eem.3212

SmartSyntaxInterpreterPlugins:
Have JPEGReadWriter2Plugin identify its struct and pointer types and hence replace some cCode:inSmalltalk: string arguments with blocks.

Simplify computing the signature map of a SmartSyntaxInterpreterPlugin by a SmartSyntaxPluginSimulator, by examining the parse tree (we're going to need to do this anyway if we need the types of the target variables to coerce correctly), instead of the bizarre (as it seems to me now) evaluation scheme. In my defence I iwll say that the evaluation scheme was implemented before Spur, and hence before primitives were routinely parsed to compute accessor depths, so back then the Smalltalk compiler was not used when simulating.

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

Item was changed:
  ----- Method: BitBltSimulator>>primitive:parameters:receiver: (in category 'simulation') -----
  primitive: primitiveName parameters: parameterTypesArray receiver: rcvrType
  	"This exists just to check the set of methods that use smart syntax for which
  	 marshallers have been written.  If a case cannot be found you'll have to write
  	 a marshaller for the case in question that follows the approach taken in the
  	 marshallers below."
+ 	^primitiveName
+ 		caseOf: {
+ 			['primitivePixelValueAt']		-> [self].
+ 			['primitiveCompareColors']	-> [self] }
+ 		otherwise: [super primitive: primitiveName parameters: parameterTypesArray receiver: rcvrType]!
- 	simulator forMap ifTrue:
- 		[Notification new
- 			tag: {#forMap. primitiveName. parameterTypesArray. rcvrType};
- 			signal].
- 	primitiveName caseOf: {
- 		['primitivePixelValueAt']		-> [^self].
- 		['primitiveCompareColors']	-> [^self] }!

Item was removed:
- ----- Method: FilePlugin>>pointerFrom: (in category 'private') -----
- pointerFrom: pointerByteArray
- 	"Answer the machine address contained in anExternalAddressOop."
- 	<inline: #always>
- 	| ptr |
- 	<var: 'ptr' type: #'void **'>
- 	((interpreterProxy isBytes: pointerByteArray)
- 	 and: [(interpreterProxy stSizeOf: pointerByteArray) = (self sizeof: #'void *')]) ifFalse:
- 		[interpreterProxy primitiveFailFor: PrimErrBadArgument.
- 		 ^nil].
- 	ptr := interpreterProxy firstIndexableField: pointerByteArray.
- 	^ptr at: 0!

Item was changed:
  ----- Method: FilePlugin>>primitiveConnectToFile (in category 'file primitives') -----
  primitiveConnectToFile
  	"Connect to the file with the supplied FILE* and writeFlag.
  	FILE* must be supplied in a byte object (ByteArray) with the platform address size.
  	writeFlag must be a boolean and compatible with the existing file access."
  	| writeFlag cfileOop cfile filePointer |
- 	<var: 'cfile' type: #'void *'>
  	<export: true>
  	writeFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
  	cfileOop := interpreterProxy stackValue: 1.
+ 	((interpreterProxy isWordsOrBytes: cfileOop)
+ 	 and: [(interpreterProxy byteSizeOf: cfileOop) = self sizeOfPointer]) ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 	cfile := (self cCoerce: (interpreterProxy firstIndexableField: cfileOop) to: #'void **') at: 0.
- 	cfile := self pointerFrom: cfileOop.
- 	interpreterProxy failed ifTrue: [
- 		"Ensure that the appropriate failure code has been set"
- 		^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	filePointer := self connectToFile: cfile write: writeFlag.
  	interpreterProxy failed ifFalse: 
  		[interpreterProxy methodReturnValue: filePointer]!

Item was added:
+ ----- Method: JPEGReadWriter2Plugin class>>structTargetKindForDeclaration: (in category 'translation') -----
+ structTargetKindForDeclaration: decl "<String>"
+ 	"We want to identify these from jpeglib.h
+ 		typedef struct jpeg_common_struct * j_common_ptr;
+ 		typedef struct jpeg_compress_struct * j_compress_ptr;
+ 		typedef struct jpeg_decompress_struct * j_decompress_ptr;
+ 
+ 		struct jpeg_compress_struct"
+ 
+ 	(decl last = $* or: [(decl beginsWith: 'j_') and: [decl endsWith: '_ptr']]) ifTrue: [^#pointer].
+ 	^(decl beginsWith: 'struct jpeg_') ifTrue: [#struct]!

Item was changed:
  ----- Method: JPEGReadWriter2Plugin>>primImageHeight: (in category 'primitives') -----
  primImageHeight: aJPEGDecompressStruct
  	<export: true>
+ 	<var: 'aJPEGDecompressStruct' type: #'j_decompress_ptr'>
  	self primitive: 'primImageHeight' parameters: #(ByteArray).
  
  	"Various parameter checks"
  	(self isValidDecompressionStruct: aJPEGDecompressStruct) ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- 		[^interpreterProxy primitiveFail].
  
+ 	interpreterProxy methodReturnInteger:
+ 			(self
+ 				cCode: [aJPEGDecompressStruct image_height]
+ 				inSmalltalk: [JPEGReadWriter2 new primImageHeight: aJPEGDecompressStruct asByteArray])!
- 	^(self
- 		cCode: '((j_decompress_ptr)aJPEGDecompressStruct)->image_height'
- 		inSmalltalk: [JPEGReadWriter2 new primImageHeight: aJPEGDecompressStruct asByteArray])
- 			asOop: SmallInteger!

Item was changed:
  ----- Method: JPEGReadWriter2Plugin>>primImageNumComponents: (in category 'primitives') -----
  primImageNumComponents: aJPEGDecompressStruct
  	<export: true>
+ 	<var: 'aJPEGDecompressStruct' type: #'j_decompress_ptr'>
  	self primitive: 'primImageNumComponents' parameters: #(ByteArray).
  
  	"Various parameter checks"
  	(self isValidDecompressionStruct: aJPEGDecompressStruct) ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- 		[^interpreterProxy primitiveFail].
  
+ 	interpreterProxy methodReturnInteger:
+ 			(self
+ 				cCode: [aJPEGDecompressStruct num_components]
+ 				inSmalltalk: [JPEGReadWriter2 new primImageNumComponents: aJPEGDecompressStruct asByteArray])!
- 	^(self
- 		cCode: '((j_decompress_ptr)aJPEGDecompressStruct)->num_components'
- 		inSmalltalk: [JPEGReadWriter2 new primImageNumComponents: aJPEGDecompressStruct asByteArray])
- 			asOop: SmallInteger!

Item was changed:
  ----- Method: JPEGReadWriter2Plugin>>primImageWidth: (in category 'primitives') -----
  primImageWidth: aJPEGDecompressStruct
  	<export: true>
+ 	<var: 'aJPEGDecompressStruct' type: #'j_decompress_ptr'>
  	self primitive: 'primImageWidth' parameters: #(ByteArray).
  
  	"Various parameter checks"
  	(self isValidDecompressionStruct: aJPEGDecompressStruct) ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- 		[^interpreterProxy primitiveFail].
  
+ 	interpreterProxy methodReturnInteger:
+ 			(self
+ 				cCode: [aJPEGDecompressStruct image_width]
+ 				inSmalltalk: [JPEGReadWriter2 new primImageWidth: aJPEGDecompressStruct asByteArray])!
- 	^(self
- 		cCode: '((j_decompress_ptr)aJPEGDecompressStruct)->image_width'
- 		inSmalltalk: [JPEGReadWriter2 new primImageWidth: aJPEGDecompressStruct asByteArray])
- 			asOop: SmallInteger!

Item was added:
+ ----- Method: SmartSyntaxInterpreterPlugin class>>parameterTypeReferences (in category 'queries') -----
+ parameterTypeReferences
+ 	"Answer a Dictionary containing two maps:
+ 		1. plugin class to set of types used in primitive:parameters:[receiver:] specs
+ 		2. {Type. type name} -> set of plugin classes using the type"
+ 	
+ 	"self parameterTypeReferences"
+ 	| them theSelectors |
+ 	them := Dictionary new.
+ 	theSelectors := #(primitive:parameters: primitive:parameters:receiver:).
+ 	self sn
+ 		allMethodsSelect:
+ 			[:m|
+ 			((theSelectors includes: m selector) not
+ 			and: [m messages includesAnyOf: theSelectors]) ifTrue:
+ 				[| add |
+ 				add := [:k| (them at: m methodClass ifAbsentPut: [Set new]) add: k. (them at: {#Type. k} ifAbsentPut: Set new) add: m methodClass name].
+ 				m methodNode block nodesDo:
+ 					[:n|
+ 					(n isMessageNode and: [theSelectors includes: n selector key]) ifTrue:
+ 						[n arguments second key do: add.
+ 						 n arguments size > 2 ifTrue:
+ 							[add value: n arguments last literalValue]]]].
+ 			false]
+ 		localTo: SmartSyntaxInterpreterPlugin.
+ 	^them collect: #sorted
+ 
+ 
+ 	"and here are some simpler precursors:"
+ 
+ 	"collect just the type:
+ 	[ | them theSelectors |
+ 	them := Set new.
+ 	theSelectors := #(primitive:parameters: primitive:parameters:receiver:).
+ 	self sn
+ 		allMethodsSelect:
+ 			[:m|
+ 			((theSelectors includes: m selector) not
+ 			and: [m messages includesAnyOf: theSelectors]) ifTrue:
+ 				[m methodNode block nodesDo:
+ 					[:n|
+ 					(n isMessageNode and: [theSelectors includes: n selector key]) ifTrue:
+ 						[them addAll: n arguments second key.
+ 						 n arguments size > 2 ifTrue:
+ 							[them add: n arguments last literalValue]]]].
+ 			false]
+ 		localTo: SmartSyntaxInterpreterPlugin.
+ 	them sorted]"
+ 
+ 	"collect just the types by plugin class:
+ 	[| them theSelectors |
+ 	them := Dictionary new.
+ 	theSelectors := #(primitive:parameters: primitive:parameters:receiver:).
+ 	self sn
+ 		allMethodsSelect:
+ 			[:m|
+ 			((theSelectors includes: m selector) not
+ 			and: [m messages includesAnyOf: theSelectors]) ifTrue:
+ 				[| add |
+ 				add := [:k| (them at: m methodClass ifAbsentPut: [Set new]) add: k].
+ 				m methodNode block nodesDo:
+ 					[:n|
+ 					(n isMessageNode and: [theSelectors includes: n selector key]) ifTrue:
+ 						[n arguments second key do: add.
+ 						 n arguments size > 2 ifTrue:
+ 							[add value: n arguments last literalValue]]]].
+ 			false]
+ 		localTo: SmartSyntaxInterpreterPlugin.
+ 	them collect: #sorted]"!

Item was changed:
  InterpreterPlugin subclass: #SmartSyntaxPluginSimulator
+ 	instanceVariableNames: 'actualPlugin signatureMap pluginClass logging'
- 	instanceVariableNames: 'actualPlugin signatureMap forMap pluginClass logging'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-SmartSyntaxPlugins'!

Item was changed:
  ----- Method: SmartSyntaxPluginSimulator>>computeSignatureFor:from: (in category 'initialize') -----
  computeSignatureFor: selector from: tuple
  	| signature |
+ 	signature := tuple second collect:
- 	self assert: tuple first == #forMap.
- 	signature := tuple third collect:
  					[:className|
  					(Smalltalk classNamed: className)
  						ifNil: [self error: 'Argument class' , className, ' does not exist']
  						ifNotNil:
  							[:argClass|
  							argClass
  								ccg: self
  								prolog: true
  								expr: [interpreterProxy primitiveFail]
  								index: nil]].
  	^signatureMap
+ 		at: tuple first asSymbol
- 		at: tuple second asSymbol
  		put: {	selector.
  				signature.
+ 				tuple third
- 				tuple fourth
  					ifNil: [[:oop| oop]]
  					ifNotNil:
  						[:rcvrClassSymbol|
  						(Smalltalk classNamed: rcvrClassSymbol)
  							ifNil: [self error: 'Receiver class' , rcvrClassSymbol, ' does not exist']
  							ifNotNil:
  								[:rcvrClass|
  								rcvrClass
  									ccg: self
  									prolog: false
  									expr: [interpreterProxy primitiveFail]
  									index: nil]] }!

Item was changed:
  ----- Method: SmartSyntaxPluginSimulator>>computeSignatureMap (in category 'initialize') -----
  computeSignatureMap
- 	forMap := true. "true only while we compute the signatureMap"
  	signatureMap := Dictionary new.
  	(pluginClass withAllSuperclasses copyUpTo: SmartSyntaxInterpreterPlugin) do:
  		[:theClass|
  		 theClass selectorsAndMethodsDo:
  			[:s :m|
  			(m messages includesAnyOf: #(primitive: primitive:parameters: primitive:parameters:receiver:))
+ 				ifTrue: [self getPrimitiveSignatureFor: m]
- 				ifTrue: [self getPrimitiveSignatureFor: s]
  				ifFalse:
  					[(m pragmaAt: #export:) ifNotNil:
  						[:exportPragma|
  						(exportPragma argumentAt: 1) ifTrue:
+ 							[self computeSignatureFor: m selector from: { s. #(). nil }]]]]]!
- 							[self computeSignatureFor: s from: { #forMap. s. #(). nil }]]]]].
- 	forMap := false!

Item was removed:
- ----- Method: SmartSyntaxPluginSimulator>>forMap (in category 'accessing') -----
- forMap
- 	^forMap!

Item was changed:
  ----- Method: SmartSyntaxPluginSimulator>>getPrimitiveSignatureFor: (in category 'initialize') -----
+ getPrimitiveSignatureFor: aMethod
+ 	"aMethod is a SmartSyntaxInterpreterPlugin method using one of the signature specifier selectors,
+ 		primitive: primitive:parameters: primitive:parameters:receiver:
+ 	Find the first one in the method and compute the signature for it via computeSignatureFor:from:"
+ 	aMethod methodNode block nodesDo:
+ 		[:n|
+ 		(n isMessageNode and: [#(primitive: primitive:parameters: primitive:parameters:receiver:) includes: n selector key]) ifTrue:
+ 			[| args primitiveName argumentClassNames receiverClassSymbolOrNil |
+ 			args := n arguments.
+ 			primitiveName := args first key.
+ 			argumentClassNames := args size > 1 ifTrue: [args second key] ifFalse: [#()].
+ 			receiverClassSymbolOrNil := args size > 2 ifTrue: [n arguments last literalValue].
+ 			^self computeSignatureFor: aMethod selector from: {primitiveName. argumentClassNames. receiverClassSymbolOrNil}]].
+ 	self error: 'can''t find primitive name in ', aMethod methodReference stringVersionDefault!
- getPrimitiveSignatureFor: s
- 	"Execute the primitive until the send of #primitive:parameters: or primitive:parameters:receiver:,
- 	collect the processed signature and store it in the map"
- 	[actualPlugin perform: s withArguments: (1 to: s numArgs) asArray]
- 		on: Notification
- 		do: [:ex|
- 			(ex tag isArray
- 			 and: [ex tag first == #forMap]) ifTrue:
- 				[^self computeSignatureFor: s from: ex tag]].
- 	self error: 'can''t find primitive name in ', s!

Item was changed:
  ----- Method: SmartSyntaxPluginSimulator>>primitive:parameters:receiver: (in category 'simulation') -----
  primitive: primNameString parameters: argumentClassNames receiver: rcvrClassSymbolOrNil
+ 	^rcvrClassSymbolOrNil ifNotNil:
+ 		[interpreterProxy stackValue: interpreterProxy methodArgumentCount]!
- 	"If initializing, pass back the type signature.  If executing, answer the receiver or nil."
- 	forMap
- 		ifTrue:
- 			[Notification new
- 				tag: {#forMap. primNameString. argumentClassNames. rcvrClassSymbolOrNil};
- 				signal]
- 		ifFalse:
- 			[^rcvrClassSymbolOrNil ifNotNil:
- 				[interpreterProxy stackValue: interpreterProxy methodArgumentCount]]!



More information about the Vm-dev mailing list