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

Levente Uzonyi leves at caesar.elte.hu
Wed Jun 24 19:05:09 UTC 2020


Hi Eliot,

On Wed, 24 Jun 2020, commits at source.squeak.org wrote:

> 
> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2761.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-eem.2761
> Author: eem
> Time: 24 June 2020, 11:15:52.846414 am
> UUID: 34b29eae-6069-4cb7-8a89-7365fb398dfb
> Ancestors: VMMaker.oscog-eem.2760
>
> Cherry Picking from various recent commits, but avoiding the extremely desirable, but as yet unfinished, VMMaker.oscog-nice.2761 transformInAssignmentTo: changes.the "thisContext method includes: 42" crash.
>
> MiscPrimitivePlugin: fix several uses of sizeOfSTArrayFromCPrimitive: that don''t check for potential failure if e.g. invoked on a CompiledMethod.  Returning from a primitive normally when the primtiive has failed leads to disaster since the stack gets cu back but shouldn't be.  For CompiledMethod isBytes: is true but isWordsOrBytes: is false.  sizeOfSTArrayFromCPrimitive: checks for isWordsOrBytes:.  The primtiives check that the argument is isBytes: but don't check if sizeOfSTArrayFromCPrimitive: fails.  More general fixes, such as fixing isBytes: to be false for CompiledMethod, or introducing isPureBytes: and using it, are not quick fixes.  hence this limited fix here.
>
> Primitive infrastructure: consequently guard the various methodReturnXXX''s with an assert to check that a primitive has not failed.
>
> Also make sure that the SpurNBitCoMemoryManagers do not follow any reference to a Cog method in the first field of a CompiledMethod.
>
> Cosmetic changes for ThreadedFFIPlugins from VMMaker.oscog-nice.2762
>
> Do not try to generate SHA256Plugin, it's obsolete and absent from latest cryptography packages. This from VMMaker.oscog-nice.2761.

While it's true that SHA256Plugin is now obsolete, simply removing it is 
not a solution. Its replacement, SHA2Plugin along with fixes to the other 
plugins is available in CryptographyPlugins-ul.22.
IMO 3 steps are required to have the plugins built and shipped with the 
VM:
1. Use CryptographyPlugins-ul.22 to generate the plugin sources, and push 
the generated files to the git repository.
2. Apply the change from VMMaker.oscog-ul.2763.mcz. It's in the VMMaker 
Inbox[1].
3. Update plugins.ext across the git repository to include all the 
plugins.

I can do 2, I can create a pull request for 3, but I can't do 1.


Levente

[1] http://lists.squeakfoundation.org/pipermail/vm-dev/2020-June/034065.html

>
> Slang:
> Fix TParseNode>>isSameAs: implementations to incluyde an identity check.  TReturnNode always answered false to this in the past.
>
> Optimize inlineFunctionCall:in: to avoid a rewrite of the copied parse tree being inlined if the actuals match the formals.  Uses the improved bindVariablesIn:.
>
> Use a setter for variable & expression in TAssignmentNode to ease breakpointing/debugging.
>
> =============== Diff against VMMaker.oscog-eem.2760 ===============
>
> Item was changed:
>  ----- Method: CogARMCompiler>>concretizeAndCqRR (in category 'generate machine code - concretize') -----
>  concretizeAndCqRR
>  	"Will get inlined into concretizeAt: switch."
>  	"AND is very important since it's used to mask all sorts of flags in the jit. We take special care to try to find compact ways to make the masks"
>  	<inline: true>
>  	| val srcReg dstReg |
>  	val := operands at: 0.
>  	srcReg := operands at: 1.
>  	dstReg := operands at: 2.
>  	self rotateable8bitBitwiseImmediate: val
>  		ifTrue:
>  			[:rot :immediate :invert|
>  			self machineCodeAt: 0 put: (invert
>  											ifTrue: [self bics: dstReg rn: srcReg imm: immediate ror: rot]
>  											ifFalse: [self ands: dstReg rn: srcReg imm: immediate ror: rot]).
>  			^4]
>  		ifFalse:
>  			[| hb |
>  			hb := (operands at: 0) highBit.
>  			"First see if the constant can be made from a simple shift of 0xFFFFFFFF"
>  			1 << hb = (val +1) ifTrue: "MVN temp reg, 0, making 0xffffffff"
>  				[self machineCodeAt: 0 put:(self mvn: ConcreteIPReg imm: 0 ror: 0).
>  				"Then AND reg, temp reg, lsr #(32-hb)"
>  				 self machineCodeAt: 4 put: (self dataOpType: AndOpcode rd: dstReg rn: srcReg rm: ConcreteIPReg lsr: 32 - hb).
> + 				^8]].
> + 	^self concretizeDataOperationCwR: AndOpcode R: dstReg!
> - 				^8].
> - 			^self concretizeDataOperationCwR: AndOpcode R: dstReg]!
>
> Item was added:
> + ----- Method: Float32Array class>>ccg:prolog:expr:index: (in category '*VMMaker-plugin generation') -----
> + ccg: cg prolog: aBlock expr: aString index: anInteger
> + 
> + 	^cg ccgLoad: aBlock expr: aString asWBFloatPtrFrom: anInteger!
>
> Item was added:
> + ----- Method: Float32Array class>>ccgDeclareCForVar: (in category '*VMMaker-plugin generation') -----
> + ccgDeclareCForVar: aSymbolOrString
> + 
> + 	^'float *', aSymbolOrString!
>
> Item was removed:
> - ----- Method: FloatArray class>>ccg:prolog:expr:index: (in category '*VMMaker-plugin generation') -----
> - ccg: cg prolog: aBlock expr: aString index: anInteger
> - 
> - 	^cg ccgLoad: aBlock expr: aString asWBFloatPtrFrom: anInteger!
>
> Item was removed:
> - ----- Method: FloatArray class>>ccgDeclareCForVar: (in category '*VMMaker-plugin generation') -----
> - ccgDeclareCForVar: aSymbolOrString
> - 
> - 	^'float *', aSymbolOrString!
>
> Item was changed:
>  ----- Method: InterpreterProxy>>methodReturnBool: (in category 'stack access') -----
>  methodReturnBool: boolean
>  	"Sets the return value for a method"
> + 	self deny: self failed.
>  	self pop: argumentCount+1 thenPushBool: boolean.
>  	^0!
>
> Item was changed:
>  ----- Method: InterpreterProxy>>methodReturnFloat: (in category 'stack access') -----
>  methodReturnFloat: aFloat
>  	"Sets the return value for a method"
>  	<var: 'aFloat' type: #double>
> + 	self deny: self failed.
>  	self pop: argumentCount+1 thenPushFloat: aFloat.
>  	^0!
>
> Item was changed:
>  ----- Method: InterpreterProxy>>methodReturnInteger: (in category 'stack access') -----
>  methodReturnInteger: integer
>  	"Sets the return value for a method"
> + 	self deny: self failed.
>  	self pop: argumentCount+1 thenPushInteger: integer.
>  	^0!
>
> Item was changed:
>  ----- Method: InterpreterProxy>>methodReturnReceiver (in category 'stack access') -----
>  methodReturnReceiver
>  	"Sets the return value for a method"
> + 	self deny: self failed.
>  	self pop: argumentCount.
>  	^0!
>
> Item was changed:
>  ----- Method: InterpreterProxy>>methodReturnString: (in category 'stack access') -----
>  methodReturnString: aCString
>  	"Attempt to answer a ByteString for a given C string as the result of a primitive."
>  	<var: 'aCString' type: #'char *'>
> + 	self deny: self failed.
>  	aCString
>  		ifNil: [primFailCode := PrimErrOperationFailed]
>  		ifNotNil:
>  			[(self stringForCString: aCString)
>  				ifNil: [primFailCode := PrimErrNoMemory]
>  				ifNotNil: [:result| self pop: argumentCount+1 thenPush: result]].
>  	^0!
>
> Item was changed:
>  ----- Method: InterpreterProxy>>methodReturnValue: (in category 'stack access') -----
>  methodReturnValue: oop
>  	"Sets the return value for a method"
> + 	self deny: self failed.
>  	self pop: argumentCount+1 thenPush: oop.
>  	^0!
>
> Item was changed:
>  ----- Method: MiscPrimitivePlugin>>primitiveCompareString (in category 'primitives') -----
>  primitiveCompareString
>  	"ByteString (class) compare: string1 with: string2 collated: order"
>  	<export: true>
>  	| len1 len2 order string1 string2 orderOop string1Oop string2Oop |
>
>  	<var: 'order' type: #'unsigned char *'>
>  	<var: 'string1' type: #'unsigned char *'>
>  	<var: 'string2' type: #'unsigned char *'>
>  	orderOop := interpreterProxy stackValue: 0.
>  	string2Oop := interpreterProxy stackValue: 1.
>  	string1Oop := interpreterProxy stackValue: 2.
>  	((interpreterProxy isBytes: orderOop)
>  	and: [(interpreterProxy isBytes: string2Oop)
>  	and: [interpreterProxy isBytes: string1Oop]]) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	order := interpreterProxy firstIndexableField: orderOop.
>  	(interpreterProxy sizeOfSTArrayFromCPrimitive: order) < 256 ifTrue:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	string1 := interpreterProxy firstIndexableField: string1Oop.
>  	string2 := interpreterProxy firstIndexableField: string2Oop.
>  	len1 := interpreterProxy sizeOfSTArrayFromCPrimitive: string1.
>  	len2 := interpreterProxy sizeOfSTArrayFromCPrimitive: string2.
> + 	interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
> + 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	0 to: (len1 min: len2) - 1 do:
>  		[ :i | | c1 c2 |
>  		c1 := order at: (string1 at: i).
>  		c2 := order at: (string2 at: i).
>  		c1 = c2 ifFalse:
>  			[^interpreterProxy methodReturnInteger: (c1 < c2 ifTrue: [1] ifFalse: [3])]].
>  	interpreterProxy methodReturnInteger:
>  		(len1 = len2 ifTrue: [2] ifFalse: [len1 < len2 ifTrue: [1] ifFalse: [3]])!
>
> Item was changed:
>  ----- Method: MiscPrimitivePlugin>>primitiveCompressToByteArray (in category 'primitives') -----
>  primitiveCompressToByteArray
>  	"Bitmap compress: bm toByteArray: ba"
>  	<export: true>
>  	| bm ba eqBytes i j k lowByte size destSize word |
>  	<var: 'ba' type: #'unsigned char *'>
>  	<var: 'bm' type: #'int *'>
>  	bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1)]
>  				inSmalltalk: [interpreterProxy
>  								cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1))
>  								to: #'int *'].
>  	interpreterProxy failed ifTrue: [^nil].
>  	(interpreterProxy isBytes: (interpreterProxy stackValue: 0)) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	(interpreterProxy isOopImmutable: (interpreterProxy stackValue: 0)) ifTrue:
>  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
>  	ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 0).
>  	size := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
>  	destSize := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
> + 	interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
> + 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	destSize < ((size * 4) + 7 + (size // 1984 * 3)) ifTrue:
>  		[^interpreterProxy primitiveFailFor: PrimErrUnsupported]. "Size may be OK but we don't know, hence fail with unsupported"
>  	i := self encodeInt: size in: ba at: 0.
>  	k := 0.
>  	[k < size] whileTrue:
>  		[word := bm at: k.
>  		lowByte := word bitAnd: 255.
>  		eqBytes := (word >> 8 bitAnd: 255) = lowByte and: [(word >> 16 bitAnd: 255) = lowByte and: [(word >> 24 bitAnd: 255) = lowByte]].
>  		j := k.
>  		[j + 1 < size and: [word = (bm at: j + 1)]] whileTrue: [j := j + 1].
>  		j > k
>  			ifTrue:
>  				[eqBytes
>  					ifTrue:
>  						[i := self encodeInt: j - k + 1 * 4 + 1 in: ba at: i.
>  						ba at: i put: lowByte.
>  						i := i + 1]
>  					ifFalse:
>  						[i := self encodeInt: j - k + 1 * 4 + 2 in: ba at: i.
>  						i := self encodeBytesOf: word in: ba at: i].
>  				k := j + 1]
>  			ifFalse:
>  				[eqBytes
>  					ifTrue:
>  						[i := self encodeInt: 1 * 4 + 1 in: ba at: i.
>  						ba at: i put: lowByte.
>  						i := i + 1.
>  						k := k + 1]
>  					ifFalse:
>  						[[j + 1 < size and: [(bm at: j) ~= (bm at: j + 1)]] whileTrue: [j := j + 1].
>  						j + 1 = size ifTrue: [j := j + 1].
>  						i := self encodeInt: j - k * 4 + 3 in: ba at: i.
>  						k to: j - 1 by: 1 do: [ :m | i := self encodeBytesOf: (bm at: m) in: ba at: i].
>  						k := j]]].
>  	interpreterProxy methodReturnInteger: i!
>
> Item was changed:
>  ----- Method: MiscPrimitivePlugin>>primitiveConvert8BitSigned (in category 'primitives') -----
>  primitiveConvert8BitSigned
>  	"SampledSound (class) convert8bitSignedFrom: aByteArray to16Bit: aSoundBuffer"
>  	<export: true>
>  	| aByteArray aSoundBuffer arraySize byteArrayOop soundBufferOop |
>
>  	<var: 'aByteArray' type: #'unsigned char *'>
>  	<var: 'aSoundBuffer' type: #'unsigned short *'>
>  	byteArrayOop := interpreterProxy stackValue: 1.
>  	(interpreterProxy isBytes: byteArrayOop) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	aByteArray := interpreterProxy firstIndexableField: byteArrayOop.
>  	soundBufferOop := interpreterProxy stackValue: 0.
> + 	(interpreterProxy isOopImmutable: soundBufferOop) ifTrue:
> + 		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
>  	aSoundBuffer := self
>  						cCode: [interpreterProxy arrayValueOf: soundBufferOop]
>  						inSmalltalk: [interpreterProxy
>  										cCoerce: (interpreterProxy arrayValueOf: soundBufferOop)
>  										to: #'unsigned short *'].
> - 	interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> - 	(interpreterProxy isOopImmutable: soundBufferOop) ifTrue:
> - 		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
>  	arraySize := interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray.
> + 	interpreterProxy failed ifTrue:
> + 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	(interpreterProxy byteSizeOf: soundBufferOop) < (2 * arraySize) ifTrue:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	0 to: arraySize - 1 do:
>  		[ :i | | s |
>  		s := aByteArray at: i.
>  		aSoundBuffer
>  			at: i
>  			put: (s > 127
>  					ifTrue: [s - 256 bitShift: 8]
>  					ifFalse: [s bitShift: 8])].
>  	interpreterProxy methodReturnReceiver!
>
> Item was changed:
>  ----- Method: MiscPrimitivePlugin>>primitiveDecompressFromByteArray (in category 'primitives') -----
>  primitiveDecompressFromByteArray
>  	"Bitmap decompress: bm fromByteArray: ba at: index"
>  	<export: true>
>  	| bm ba index i anInt code data end k n pastEnd |
>  	<var: 'ba' type: #'unsigned char *'>
>  	<var: 'bm' type: #'int *'>
>  	<var: 'anInt' type: #'unsigned int'>
>  	<var: 'code' type: #'unsigned int'>
>  	<var: 'data' type: #'unsigned int'>
>  	<var: 'n' type: #'unsigned int'>
>  	bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2)]
>  				inSmalltalk: [interpreterProxy
>  								cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2))
>  								to: #'int *'].
>  	(interpreterProxy isOopImmutable: (interpreterProxy stackValue: 2)) ifTrue:
>  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
>  	(interpreterProxy isBytes: (interpreterProxy stackValue: 1)) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 1).
>  	index := interpreterProxy stackIntegerValue: 0.
> - 	interpreterProxy failed ifTrue: [^nil].
> - 	i := index - 1.
> - 	k := 0.
>  	end := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
>  	pastEnd := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
> + 	interpreterProxy failed ifTrue:
> + 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> + 	i := index - 1.
> + 	k := 0.
>  	[i < end] whileTrue:
>  		[anInt := ba at: i.
>  		i := i + 1.
>  		anInt <= 223 ifFalse:
>  			[anInt <= 254
>  				ifTrue:
>  					[anInt := anInt - 224 * 256 + (ba at: i).
>  					i := i + 1]
>  				ifFalse:
>  					[anInt := 0.
>  					1 to: 4 by: 1 do:
>  						[ :j | anInt := (anInt bitShift: 8) + (ba at: i).
>  						i := i + 1]]].
>  		n := anInt >> 2.
>  		k + n > pastEnd ifTrue:
>  			[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
>  		code := anInt bitAnd: 3.
>  		"code = 0 ifTrue: [nil]."
>  		code = 1 ifTrue:
>  			[data := ba at: i.
>  			i := i + 1.
>  			data := data bitOr: (data bitShift: 8).
>  			data := data bitOr: (data bitShift: 16).
>  			1 to: n do:
>  				[ :j |
>  				bm at: k put: data.
>  				k := k + 1]].
>  		code = 2 ifTrue:
>  			[data := 0.
>  			1 to: 4 do:
>  				[ :j |
>  				data := (data bitShift: 8) bitOr: (ba at: i).
>  				i := i + 1].
>  			1 to: n do:
>  				[ :j |
>  				bm at: k put: data.
>  				k := k + 1]].
>  		code = 3 ifTrue:
>  			[1 to: n do:
>  				[ :m |
>  				data := 0.
>  				1 to: 4 do:
>  					[ :j |
>  					data := (data bitShift: 8) bitOr: (ba at: i).
>  					i := i + 1].
>  				bm at: k put: data.
>  				k := k + 1]]].
>  	interpreterProxy pop: interpreterProxy methodArgumentCount!
>
> Item was changed:
>  ----- Method: MiscPrimitivePlugin>>primitiveFindFirstInString (in category 'primitives') -----
>  primitiveFindFirstInString
>  	"ByteString (class) findFirstInString: aString inSet: inclusionMap  startingAt: start"
>  	<export: true>
>
>  	|  aString i inclusionMap stringSize aStringOop inclusionMapOop |
>  	<var: 'aString' type: #'unsigned char *'>
>  	<var: 'inclusionMap' type: #'unsigned char *'>
>  	aStringOop := interpreterProxy stackValue: 2.
>  	(interpreterProxy isBytes: aStringOop) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	inclusionMapOop :=  interpreterProxy stackValue: 1.
>  	(interpreterProxy isBytes: inclusionMapOop) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	i := interpreterProxy stackIntegerValue: 0.
> + 	interpreterProxy failed ifTrue:
> + 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> - 	interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	i := i - 1. "Convert to 0-based index."
>  	i < 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
>  	inclusionMap := interpreterProxy firstIndexableField: inclusionMapOop.
>  	(interpreterProxy sizeOfSTArrayFromCPrimitive: inclusionMap) ~= 256 ifTrue:
>  		[^interpreterProxy methodReturnInteger: 0].
>  	aString := interpreterProxy firstIndexableField: aStringOop.
>  	stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
> + 	interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
> + 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	[i < stringSize and: [(inclusionMap at: (aString at: i)) = 0]] whileTrue:
>  		[i := i + 1].
>  	interpreterProxy methodReturnInteger: (i >= stringSize ifTrue: [0] ifFalse: [i + 1])!
>
> Item was changed:
>  ----- Method: MiscPrimitivePlugin>>primitiveFindSubstring (in category 'primitives') -----
>  primitiveFindSubstring
>  	"ByteString findSubstring: key in: body startingAt: start matchTable: matchTable"
>  	<export: true>
> 
> + 	| body key keySize bodySize matchTable start bodyOop keyOop matchTableOop |
> - 	| body key keySize matchTable start bodyOop keyOop matchTableOop |
>  	<var: #key type: #'unsigned char *'>
>  	<var: #body type: #'unsigned char *'>
>  	<var: #matchTable type: #'unsigned char *'>
>  	keyOop := interpreterProxy stackValue: 3.
>  	(interpreterProxy isBytes: keyOop) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	bodyOop := interpreterProxy stackValue: 2.
>  	(interpreterProxy isBytes: bodyOop) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	start := interpreterProxy stackIntegerValue: 1.
>  	interpreterProxy failed ifTrue:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	matchTableOop := interpreterProxy stackValue: 0.
>  	(interpreterProxy isBytes: matchTableOop) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	matchTable := interpreterProxy firstIndexableField: matchTableOop.
>  	(interpreterProxy sizeOfSTArrayFromCPrimitive: matchTable) < 256 ifTrue:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	key := interpreterProxy firstIndexableField: keyOop.
>  	(keySize := interpreterProxy sizeOfSTArrayFromCPrimitive: key) > 0 ifTrue:
>  		[keySize := keySize - 1. "adjust for zero relative indexes"
>  		start := start - 1 max: 0. "adjust for zero relative indexes"
> + 		body := interpreterProxy firstIndexableField: bodyOop.
> + 		bodySize := interpreterProxy sizeOfSTArrayFromCPrimitive: body.
> + 		interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
> + 			[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> + 		start to: bodySize - 1 - keySize do: 
> - 		body := interpreterProxy firstIndexableField: bodyOop. 
> - 		start to: (interpreterProxy sizeOfSTArrayFromCPrimitive: body) - 1 - keySize do:
>  			[ :startIndex | | index |
>  			index := 0.
>  			[(matchTable at: (body at: startIndex + index)) = (matchTable at: (key at: index))] whileTrue:
>  				[index = keySize ifTrue:
>  					[^interpreterProxy methodReturnInteger: startIndex + 1].
>  				index := index + 1]]].
>  	^interpreterProxy methodReturnInteger: 0!
>
> Item was changed:
>  ----- Method: MiscPrimitivePlugin>>primitiveIndexOfAsciiInString (in category 'primitives') -----
>  primitiveIndexOfAsciiInString
>  	"ByteString indexOfAscii: anInteger inString: aString startingAt: start"
>  	<export: true>
> 
> + 	| integerOop startOop anInteger aString start stringSize stringOop |
> - 	| anInteger aString start stringSize aStringOop |
>  	<var: #aString type: #'unsigned char *'>
> + 	integerOop := interpreterProxy stackValue: 2.
> + 	stringOop := interpreterProxy stackValue: 1.
> + 	startOop := interpreterProxy stackValue: 0.
> + 	((interpreterProxy isIntegerObject: integerOop)
> + 	 and: [(interpreterProxy isIntegerObject: startOop)
> + 	 and: [(interpreterProxy isBytes: stringOop)
> + 	 and: [interpreterProxy isWordsOrBytes: stringOop]]]) ifFalse: "sizeOfSTArrayFromCPrimitive: is defined only for words or bytes"
> - 	anInteger := interpreterProxy stackIntegerValue: 2.
> - 	interpreterProxy failed ifTrue:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> + 	(start := interpreterProxy integerValueOf: startOop) >= 1 ifFalse:
> + 		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
> + 	anInteger := interpreterProxy integerValueOf: integerOop.
> + 	aString := interpreterProxy firstIndexableField: stringOop.
> - 	aStringOop := interpreterProxy stackValue: 1.
> - 	(interpreterProxy isBytes: aStringOop) ifFalse:
> - 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> - 	start := interpreterProxy stackIntegerValue: 0. 
> - 	interpreterProxy failed ifTrue: 
> - 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> - 	start >= 1 ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
> - 	aString := interpreterProxy firstIndexableField: aStringOop.
>  	stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
>  	start - 1 to: stringSize - 1 do:
> + 		[:pos |
> - 		[ :pos |
>  		(aString at: pos) = anInteger ifTrue:
>  			[^interpreterProxy methodReturnInteger: pos + 1]].
>  	^interpreterProxy methodReturnInteger: 0!
>
> Item was changed:
>  ----- Method: MiscPrimitivePlugin>>primitiveStringHash (in category 'primitives') -----
>  primitiveStringHash
>  	"ByteArray (class) hashBytes: aByteArray startingWith: speciesHash"
>  	<export: true>
>
>  	| aByteArray hash byteArrayOop |
>  	<var: 'aByteArray' type: #'unsigned char *'>
>  	<var: 'hash' type: #'unsigned int'>
>  	hash := interpreterProxy stackIntegerValue: 0.
>  	interpreterProxy failed ifTrue:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	byteArrayOop := interpreterProxy stackValue: 1.
> + 	((interpreterProxy isBytes: byteArrayOop)
> + 	and: [interpreterProxy isWordsOrBytes: byteArrayOop]) ifFalse: "filters out CompiledMethods"
> - 	(interpreterProxy isBytes: byteArrayOop) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	aByteArray := interpreterProxy firstIndexableField: byteArrayOop.
>  	0 to: (interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray) - 1 do:
>  		[ :pos |
>  		hash := hash + (aByteArray at: pos) * 16r19660D ].
>  	interpreterProxy methodReturnInteger: (hash bitAnd: 16r0FFFFFFF)!
>
> Item was changed:
>  ----- Method: MiscPrimitivePlugin>>primitiveTranslateStringWithTable (in category 'primitives') -----
>  primitiveTranslateStringWithTable
>  	"ByteString (class) translate: aString from: start to: stop table: table"
>  	<export: true>
>
>  	| aString start stop table aStringOop tableOop |
>  	<var: #table type: #'unsigned char *'>
>  	<var: #aString type: #'unsigned char *'>
>  	aStringOop := interpreterProxy stackValue: 3.
>  	(interpreterProxy isBytes: aStringOop) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	(interpreterProxy isOopImmutable: aStringOop) ifTrue:
>  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
>  	start := interpreterProxy stackIntegerValue: 2.
> - 	interpreterProxy failed ifTrue:
> - 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	stop := interpreterProxy stackIntegerValue: 1.
>  	interpreterProxy failed ifTrue:
> + 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> - 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	tableOop := interpreterProxy stackValue: 0.
>  	(interpreterProxy isBytes: tableOop) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	aString := interpreterProxy firstIndexableField: aStringOop.
>  	(start >= 1 and: [stop <= (interpreterProxy sizeOfSTArrayFromCPrimitive: aString)]) ifFalse:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
>  	table := interpreterProxy firstIndexableField: tableOop.
>  	(interpreterProxy sizeOfSTArrayFromCPrimitive: table) < 256 ifTrue:
>  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
> + 	interpreterProxy failed ifTrue:
> + 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
>  	start - 1 to: stop - 1 do: [ :i | aString at: i put: (table at: (aString at: i))].
>  	interpreterProxy methodReturnReceiver!
>
> Item was added:
> + ----- Method: Spur32BitCoMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
> + followForwardedObjectFields: objOop toDepth: depth
> + 	"Follow pointers in the object to depth.
> + 	 Answer if any forwarders were found.
> + 	 How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite."
> + 	<api>
> + 	<inline: false>
> + 	| found fmt numSlots |
> + 	found := false.
> + 	self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
> + 	fmt := self formatOf: objOop.
> + 	numSlots := self numPointerSlotsOf: objOop format: fmt.
> + 	"It is essential to skip the first field of a method because it may be a
> + 	 reference to a Cog method in the method zone, not a real object at all."
> + 	((self isCompiledMethodFormat: fmt)
> + 			ifTrue: [1]
> + 			ifFalse: [0])
> + 		to: numSlots - 1
> + 		do: [:i| | oop |
> + 			oop := self fetchPointer: i ofObject: objOop.
> + 			(self isNonImmediate: oop) ifTrue:
> + 				[(self isForwarded: oop) ifTrue:
> + 					[found := true.
> + 					 oop := self followForwarded: oop.
> + 					 self storePointer: i ofObject: objOop withValue: oop].
> + 				(depth > 0
> + 				 and: [(self hasPointerFields: oop)
> + 				 and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue:
> + 					[found := true]]].
> + 	^found!
>
> Item was added:
> + ----- Method: Spur64BitCoMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
> + followForwardedObjectFields: objOop toDepth: depth
> + 	"Follow pointers in the object to depth.
> + 	 Answer if any forwarders were found.
> + 	 How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite."
> + 	<api>
> + 	<inline: false>
> + 	| found fmt numSlots |
> + 	found := false.
> + 	self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
> + 	fmt := self formatOf: objOop.
> + 	numSlots := self numPointerSlotsOf: objOop format: fmt.
> + 	"It is essential to skip the first field of a method because it may be a
> + 	 reference to a Cog method in the method zone, not a real object at all."
> + 	((self isCompiledMethodFormat: fmt)
> + 			ifTrue: [1]
> + 			ifFalse: [0])
> + 		to: numSlots - 1
> + 		do: [:i| | oop |
> + 			oop := self fetchPointer: i ofObject: objOop.
> + 			(self isNonImmediate: oop) ifTrue:
> + 				[(self isForwarded: oop) ifTrue:
> + 					[found := true.
> + 					 oop := self followForwarded: oop.
> + 					 self storePointer: i ofObject: objOop withValue: oop].
> + 				(depth > 0
> + 				 and: [(self hasPointerFields: oop)
> + 				 and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue:
> + 					[found := true]]].
> + 	^found!
>
> Item was changed:
>  ----- Method: SpurMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
>  followForwardedObjectFields: objOop toDepth: depth
>  	"Follow pointers in the object to depth.
>  	 Answer if any forwarders were found.
> + 	 How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite."
> - 	 How to avoid cyclic structures?? A temproary mark bit?"
>  	<api>
>  	<inline: false>
> + 	| found numSlots |
> - 	| oop found |
>  	found := false.
>  	self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
> + 	numSlots  := self numPointerSlotsOf: objOop.
> + 	0 to: numSlots - 1 do:
> + 		[:i| | oop |
> - 	0 to: (self numPointerSlotsOf: objOop) - 1 do:
> - 		[:i|
>  		 oop := self fetchPointer: i ofObject: objOop.
>  		 (self isNonImmediate: oop) ifTrue:
>  			[(self isForwarded: oop) ifTrue:
>  				[found := true.
>  				 oop := self followForwarded: oop.
>  				 self storePointer: i ofObject: objOop withValue: oop].
>  			(depth > 0
>  			 and: [(self hasPointerFields: oop)
>  			 and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue:
>  				[found := true]]].
>  	^found!
>
> Item was changed:
>  ----- Method: SpurMemoryManager>>numPointerSlotsOf: (in category 'object access') -----
>  numPointerSlotsOf: objOop
>  	"Answer the number of pointer fields in the given object.
>  	 Works with CompiledMethods, as well as ordinary objects."
>  	<api>
>  	<inline: true>
> + 	| fmt |
> - 	| fmt contextSize numLiterals header |
>  	fmt := self formatOf: objOop.
> + 	^self numPointerSlotsOf: objOop format: fmt!
> - 	fmt <= self lastPointerFormat ifTrue:
> - 		[(fmt = self indexablePointersFormat
> - 		  and: [self isContextNonImm: objOop]) ifTrue:
> - 			["contexts end at the stack pointer"
> - 			contextSize := coInterpreter fetchStackPointerOf: objOop.
> - 			^CtxtTempFrameStart + contextSize].
> - 		^self numSlotsOf: objOop  "all pointers"].
> - 	fmt = self forwardedFormat ifTrue: [^1].
> - 	fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
> - 
> - 	"CompiledMethod: contains both pointers and bytes"
> - 	header := self methodHeaderOf: objOop.
> - 	numLiterals := self literalCountOfMethodHeader: header.
> - 	^numLiterals + LiteralStart!
>
> Item was added:
> + ----- Method: SpurMemoryManager>>numPointerSlotsOf:format: (in category 'object access') -----
> + numPointerSlotsOf: objOop format: fmt
> + 	"Answer the number of pointer fields in the given object.
> + 	 Works with CompiledMethods, as well as ordinary objects."
> + 	<inline: #always>
> + 	| contextSize numLiterals header |
> + 	fmt <= self lastPointerFormat ifTrue:
> + 		[(fmt = self indexablePointersFormat
> + 		  and: [self isContextNonImm: objOop]) ifTrue:
> + 			["contexts end at the stack pointer"
> + 			contextSize := coInterpreter fetchStackPointerOf: objOop.
> + 			^CtxtTempFrameStart + contextSize].
> + 		^self numSlotsOf: objOop  "all pointers"].
> + 	fmt = self forwardedFormat ifTrue: [^1].
> + 	fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
> + 
> + 	"CompiledMethod: contains both pointers and bytes"
> + 	header := self methodHeaderOf: objOop.
> + 	numLiterals := self literalCountOfMethodHeader: header.
> + 	^numLiterals + LiteralStart!
>
> Item was changed:
>  ----- Method: StackInterpreter>>methodReturnBool: (in category 'plugin primitive support') -----
>  methodReturnBool: boolean
>  	"Sets the return value for a method.  In the CoInterpreter we replace the cumbersome
>  	 primResult machinery."
> + 	self deny: self failed.
>  	self pop: argumentCount+1 thenPushBool: boolean.
>  	^0!
>
> Item was changed:
>  ----- Method: StackInterpreter>>methodReturnFloat: (in category 'plugin primitive support') -----
>  methodReturnFloat: aFloat
>  	"Sets the return value for a method."
>  	<var: 'aFloat' type: #double>
> + 	self deny: self failed.
>  	self pop: argumentCount+1 thenPushFloat: aFloat.
>  	^0!
>
> Item was changed:
>  ----- Method: StackInterpreter>>methodReturnInteger: (in category 'plugin primitive support') -----
>  methodReturnInteger: integer
>  	"Sets the return value for a method.  In the CoInterpreter we replace the cumbersome
>  	 primResult machinery."
> + 	self deny: self failed.
>  	self pop: argumentCount+1 thenPushInteger: integer.
>  	^0!
>
> Item was changed:
>  ----- Method: StackInterpreter>>methodReturnReceiver (in category 'plugin primitive support') -----
>  methodReturnReceiver
>  	"Sets the return value for a method"
> + 	self deny: self failed.
>  	self pop: argumentCount.
>  	^0!
>
> Item was changed:
>  ----- Method: StackInterpreter>>methodReturnString: (in category 'plugin primitive support') -----
>  methodReturnString: aCString
>  	"Attempt to answer a ByteString for a given C string as the result of a primitive."
>  	<var: 'aCString' type: #'char *'>
> + 	self deny: self failed.
>  	aCString
>  		ifNil: [primFailCode := PrimErrOperationFailed]
>  		ifNotNil:
>  			[(self stringForCString: aCString)
>  				ifNil: [primFailCode := PrimErrNoMemory]
>  				ifNotNil: [:result| self pop: argumentCount+1 thenPush: result]].
>  	^0!
>
> Item was changed:
>  ----- Method: StackInterpreter>>methodReturnValue: (in category 'plugin primitive support') -----
>  methodReturnValue: oop
>  	"Sets the return value for a method.  In the CoInterpreter we replace the cumbersome
>  	 primResult machinery."
> + 	self deny: self failed.
>  	self pop: argumentCount+1 thenPush: oop.
>  	^0!
>
> Item was changed:
>  ----- Method: TAssignmentNode>>bindVariablesIn: (in category 'transformations') -----
>  bindVariablesIn: aDictionary
> 
> + 	self setVar: (variable bindVariablesIn: aDictionary)
> + 		exp: (expression bindVariablesIn: aDictionary)!
> - 	variable := variable bindVariablesIn: aDictionary.
> - 	expression := expression bindVariablesIn: aDictionary.!
>
> Item was changed:
>  ----- Method: TAssignmentNode>>isSameAs: (in category 'testing') -----
>  isSameAs: aTParseNode
> + 	^self == aTParseNode
> + 	 or: [aTParseNode isAssignment
> + 		 and: [(variable isSameAs: aTParseNode variable)
> + 		 and: [expression isSameAs: aTParseNode expression]]]!
> - 	^aTParseNode isAssignment
> - 	 and: [(variable isSameAs: aTParseNode variable)
> - 	 and: [expression isSameAs: aTParseNode expression]]!
>
> Item was changed:
>  ----- Method: TAssignmentNode>>postCopy (in category 'copying') -----
>  postCopy
> 
> + 	self setVar: variable copy exp: expression copy!
> - 	variable := variable copy.
> - 	expression := expression copy!
>
> Item was changed:
>  ----- Method: TAssignmentNode>>replaceNodesIn: (in category 'transformations') -----
>  replaceNodesIn: aDictionary
> 
> + 	^aDictionary
> + 		at: self
> + 		ifAbsent:
> + 			[self setVar: (variable replaceNodesIn: aDictionary)
> + 				exp: (expression replaceNodesIn: aDictionary)]!
> - 	^aDictionary at: self ifAbsent: [
> - 		variable := variable replaceNodesIn: aDictionary.
> - 		expression := expression replaceNodesIn: aDictionary.
> - 		self]!
>
> Item was added:
> + ----- Method: TAssignmentNode>>setVar:exp: (in category 'private') -----
> + setVar: varNode exp: expressionNode
> + 	"This is a private setter, just for breakpointing..."
> + 	variable := varNode.
> + 	expression := expressionNode!
>
> Item was changed:
>  ----- Method: TConstantNode>>isSameAs: (in category 'comparing') -----
>  isSameAs: aTParseNode
> + 	^self == aTParseNode
> + 	 or: [aTParseNode isConstant
> + 		 and: [value class == aTParseNode value class
> + 		 and: [value = aTParseNode value]]]!
> - 	^aTParseNode isConstant
> - 	 and: [value class == aTParseNode value class
> - 	 and: [value = aTParseNode value]]!
>
> Item was changed:
>  ----- Method: TDefineNode>>isSameAs: (in category 'comparing') -----
>  isSameAs: aTParseNode
> + 	^self == aTParseNode
> + 	 or: [self class == aTParseNode class
> + 		  and: [value class == aTParseNode value class
> + 		  and: [value = aTParseNode value
> + 		  and: [name = aTParseNode nameOrValue]]]]!
> - 	^self class == aTParseNode class
> - 	  and: [value class == aTParseNode value class
> - 	  and: [value = aTParseNode value
> - 	  and: [name = aTParseNode nameOrValue]]]!
>
> Item was changed:
>  ----- Method: TMethod>>deny: (in category 'error handling') -----
>  deny: aBooleanOrBlock
> - 	<doNotGenerate>
>  	aBooleanOrBlock value ifTrue: [AssertionFailure signal: 'Assertion failed']!
>
> Item was changed:
>  ----- Method: TMethod>>inlineFunctionCall:in: (in category 'inlining') -----
>  inlineFunctionCall: aSendNode in: aCodeGen
>  	"Answer the body of the called function, substituting the actual
>  	 parameters for the formal argument variables in the method body.
>  	 Assume caller has established that:
>  		1. the method arguments are all substitutable nodes, and
>  		2. the method to be inlined contains no additional embedded returns."
>
>  	| sel meth doNotRename argsForInlining substitutionDict |
> + 	aCodeGen maybeBreakForInlineOf: aSendNode in: self.
>  	sel := aSendNode selector.
>  	meth := (aCodeGen methodNamed: sel) copy.
>  	meth ifNil:
>  		[^self inlineBuiltin: aSendNode in: aCodeGen].
>  	doNotRename := Set withAll: args.
>  	argsForInlining := aSendNode argumentsForInliningCodeGenerator: aCodeGen.
>  	meth args with: argsForInlining do:
>  		[ :argName :exprNode |
>  		exprNode isLeaf ifTrue:
>  			[doNotRename add: argName]].
>  	(meth statements size = 2
>  	and: [meth statements first isSend
>  	and: [meth statements first selector == #flag:]]) ifTrue:
>  		[meth statements removeFirst].
>  	meth renameVarsForInliningInto: self except: doNotRename in: aCodeGen.
>  	meth renameLabelsForInliningInto: self.
>  	self addVarsDeclarationsAndLabelsOf: meth except: doNotRename.
>  	substitutionDict := Dictionary new: meth args size * 2.
>  	meth args with: argsForInlining do:
>  		[ :argName :exprNode |
> + 		(exprNode isVariable and: [exprNode name = argName]) ifFalse:
> + 			[substitutionDict at: argName put: exprNode].
> - 		substitutionDict at: argName put: exprNode.
>  		(doNotRename includes: argName) ifFalse:
>  			[locals remove: argName]].
>  	meth parseTree bindVariablesIn: substitutionDict.
>  	^meth parseTree endsWithReturn
>  		ifTrue: [meth parseTree copyWithoutReturn]
>  		ifFalse: [meth parseTree]!
>
> Item was added:
> + ----- Method: TParseNode>>deny: (in category 'as yet unclassified') -----
> + deny: aBooleanOrBlock
> + 	aBooleanOrBlock value ifTrue: [AssertionFailure signal: 'Assertion failed']!
>
> Item was changed:
>  ----- Method: TParseNode>>isSameAs: (in category 'comparing') -----
>  isSameAs: aTParseNode
>  	"Answer if the ParseTree rooted at this node is the same as aTParseNode.
>  	 By default answer false and have subclasses override as appropriate."
> + 	^self == aTParseNode!
> - 	^false!
>
> Item was added:
> + ----- Method: TReturnNode>>isSameAs: (in category 'comparing') -----
> + isSameAs: aTParseNode
> + 	^self == aTParseNode
> + 	 or: [aTParseNode isReturn
> + 		 and: [expression isSameAs: aTParseNode expression]]!
>
> Item was changed:
>  ----- Method: TSendNode>>isSameAs: (in category 'comparing') -----
>  isSameAs: aTParseNode
> + 	self == aTParseNode ifTrue: [^true].
>  	(aTParseNode isSend
>  	 and: [selector == aTParseNode selector
>  	 and: [receiver isSameAs: aTParseNode receiver]]) ifFalse:
>  		[^false].
>  	arguments with: aTParseNode args do:
>  		[:a :b|
>  		(a isSameAs: b) ifFalse:
>  			[^false]].
>  	^true!
>
> Item was changed:
>  ----- Method: TStmtListNode>>bindVariablesIn: (in category 'transformations') -----
>  bindVariablesIn: aDictionary
> 
> + 	aDictionary notEmpty ifTrue:
> + 		[statements := statements collect: [:s| s bindVariablesIn: aDictionary]]!
> - 	statements := statements collect: [ :s | s bindVariablesIn: aDictionary ].!
>
> Item was changed:
>  ----- Method: TStmtListNode>>isSameAs: (in category 'testing') -----
>  isSameAs: aTParseNode
> + 	self == aTParseNode ifTrue: [^true].
>  	(aTParseNode isStmtList
>  	 and: [statements size = aTParseNode statements size]) ifFalse:
>  		[^false].
>  	statements with: aTParseNode statements do:
>  		[:mine :theirs|
>  		 (mine isSameAs: theirs) ifFalse:
>  			[^false]].
>  	^true!
>
> Item was changed:
>  ----- Method: TVariableNode>>isSameAs: (in category 'comparing') -----
>  isSameAs: aTParseNode
> + 	^self == aTParseNode
> + 	 or: [aTParseNode isVariable
> + 		 and: [name = aTParseNode name]]!
> - 	^aTParseNode isVariable
> - 	 and: [name = aTParseNode name]!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>canReturnInRegistersStructOfSize: (in category 'marshalling-struct') -----
> - ----- Method: ThreadedFFIPlugin>>canReturnInRegistersStructOfSize: (in category 'marshalling') -----
>  canReturnInRegistersStructOfSize: returnStructSize
>  	"Answer if a struct result of a given size can be returned via registers or not.
>  	Size is a necessary condition, but it might not be a sufficient condition.
>  	For example, SysV X64 also require that struct fields be properly aligned."
>  	^self subclassResponsibility!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>ffiPushSignedLongLongOop:in: (in category 'marshalling') -----
> - ----- Method: ThreadedFFIPlugin>>ffiPushSignedLongLongOop:in: (in category 'callout support') -----
>  ffiPushSignedLongLongOop: oop in: calloutState
>  	<var: #calloutState type: #'CalloutState *'>
>  	"Push a longlong type (e.g., a 64bit integer).
>  	Note: Coercions from float are *not* supported."
>  	| value |
>  	<var: #value type: #sqLong>
>  	(oop = interpreterProxy nilObject
>  	 or: [oop = interpreterProxy falseObject])
>  		ifTrue:[value := 0] ifFalse:
>  	[oop = interpreterProxy trueObject
>  		ifTrue:[value := 1] ifFalse:
>  	[value := interpreterProxy signed64BitValueOf: oop.
>  	 interpreterProxy failed ifTrue:
>  		[^FFIErrorCoercionFailed]]].
>  	^self ffiPushSignedLongLong: value in: calloutState!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling-struct') -----
> - ----- Method: ThreadedFFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
>  ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
>  	<var: #pointer type: #'void *'>
>  	<var: #argSpec type: #'sqInt *'>
>  	<var: #calloutState type: #'CalloutState *'>
>  	<inline: true>
>  	self subclassResponsibility!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>ffiPushStructureContentsOf:in: (in category 'marshalling-struct') -----
> - ----- Method: ThreadedFFIPlugin>>ffiPushStructureContentsOf:in: (in category 'callout support') -----
>  ffiPushStructureContentsOf: oop in: calloutState
>  	<var: #calloutState type: #'CalloutState *'>
>  	"Push the contents of the given external structure"
>  	| ptrClass ptrAddress |
>  	<inline: true>
>  	ptrClass := interpreterProxy fetchClassOf: oop.
>  	ptrClass = interpreterProxy classExternalAddress ifTrue: "ExternalAddress is bytes"
>  		[ptrAddress := (interpreterProxy fetchPointer: 0 ofObject: oop) asVoidPointer.
>  		"There is no way we can make sure the structure is valid.
>  		But we can at least check for attempts to pass pointers to ST memory."
>  		(interpreterProxy isInMemory: ptrAddress) ifTrue:
>  			[^FFIErrorInvalidPointer].
>  		^self ffiPushStructure: ptrAddress
>  			ofSize: (calloutState ffiArgHeader bitAnd: FFIStructSizeMask)
>  			typeSpec: calloutState ffiArgSpec
>  			ofLength: calloutState ffiArgSpecSize
>  			in: calloutState].
>  	ptrClass = interpreterProxy classByteArray ifTrue:
>  		["The following is a somewhat pessimistic test but I like being sure..."
>  		(interpreterProxy byteSizeOf: oop) = (calloutState ffiArgHeader bitAnd: FFIStructSizeMask)
>  			ifFalse:[^FFIErrorStructSize].
>  		ptrAddress := interpreterProxy firstIndexableField: oop.
>  		(calloutState ffiArgHeader anyMask: FFIFlagPointer) ifFalse:
>  			"Since this involves passing the address of the first indexable field we need to fail
>  			  the call if it is threaded and the object is young, since it may move during the call."
>  			[self cppIf: COGMTVM ifTrue:
>  			 [((calloutState callFlags anyMask: FFICallFlagThreaded)
>  			 and: [interpreterProxy isYoung: oop]) ifTrue:
>  				[^PrimErrObjectMayMove negated]].
>  			^self ffiPushStructure: ptrAddress
>  				ofSize: (calloutState ffiArgHeader bitAnd: FFIStructSizeMask)
>  				typeSpec: calloutState ffiArgSpec
>  				ofLength: calloutState ffiArgSpecSize
>  				in: calloutState].
>  		"If FFIFlagPointer + FFIFlagStructure is set use ffiPushPointer on the contents"
>  		(calloutState ffiArgHeader bitAnd: FFIStructSizeMask) = BytesPerWord ifFalse:
>  			[^FFIErrorStructSize].
>  		ptrAddress := (interpreterProxy fetchPointer: 0 ofObject: oop) asVoidPointer.
>  		(interpreterProxy isInMemory: ptrAddress) ifTrue:
>  			[^FFIErrorInvalidPointer].
>  		^self ffiPushPointer: ptrAddress in: calloutState].
>  	^FFIErrorBadArg!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>ffiPushUnsignedLongLongOop:in: (in category 'marshalling') -----
> - ----- Method: ThreadedFFIPlugin>>ffiPushUnsignedLongLongOop:in: (in category 'callout support') -----
>  ffiPushUnsignedLongLongOop: oop in: calloutState
>  	<var: #calloutState type: #'CalloutState *'>
>  	"Push an unsigned longlong type (e.g., a 64bit integer).
>  	Note: Coercions from float are *not* supported."
>  	| value |
>  	<var: #value type: #usqLong>
>  	(oop = interpreterProxy nilObject
>  	 or: [oop = interpreterProxy falseObject])
>  		ifTrue:[value := 0] ifFalse:
>  	[oop = interpreterProxy trueObject
>  		ifTrue:[value := 1] ifFalse:
>  	[value := interpreterProxy positive64BitValueOf: oop.
>  	 interpreterProxy failed ifTrue:
>  		[^FFIErrorCoercionFailed]]].
>  	^self ffiPushUnsignedLongLong: value in: calloutState!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>ffiPushVoid:in: (in category 'marshalling') -----
> - ----- Method: ThreadedFFIPlugin>>ffiPushVoid:in: (in category 'callout support') -----
>  ffiPushVoid: ignored in: calloutState
>  	<var: #calloutState type: #'CalloutState *'>
>  	"This is a fallback in case somebody tries to pass a 'void' value.
>  	We could simply ignore the argument but I think it's better to let
>  	the caller know what he did"
>  	^FFIErrorAttemptToPassVoid!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>nonRegisterStructReturnIsViaImplicitFirstArgument (in category 'marshalling-struct') -----
> - ----- Method: ThreadedFFIPlugin>>nonRegisterStructReturnIsViaImplicitFirstArgument (in category 'marshalling') -----
>  nonRegisterStructReturnIsViaImplicitFirstArgument
>  	"Answer if a struct returned in memory is returned to the
>  	 referent of a pointer passed as an implciit first argument.
>  	 It almost always is.  Subclasses can override if not."
>  	^true!
>
> Item was changed:
> + ----- Method: ThreadedFFIPlugin>>returnStructInRegisters: (in category 'marshalling-struct') -----
> - ----- Method: ThreadedFFIPlugin>>returnStructInRegisters: (in category 'marshalling') -----
>  returnStructInRegisters: calloutState
>  	"Answer if struct result is returned in registers or not.
>  	Use the OS specific encoding stored in structReturnType.
>  	Since it is OS dependent, leave the responsibility to subclass"
>  	<var: #calloutState type: #'CalloutState *'>
>  	^self subclassResponsibility!
>
> Item was changed:
>  ----- Method: ThreadedX64SysVFFIPlugin>>registerType:ForUnionSpecs:OfLength:StartingAt:ByteOffset:EightbyteOffset: (in category 'marshalling') -----
>  registerType: initialRegisterType ForUnionSpecs: specs OfLength: specSize StartingAt: indexPtr ByteOffset: byteOffset EightbyteOffset: eightbyteOffset
>  	"Answer with a number characterizing the register type for passing a union of size <= 16 bytes.
>  	On input, the index points to the structure header (the one with FFIFlagStructure + structSize)
>  	On output, the index points to the structure trailer (the FFIFlagStructure)."
>
>  	<var: #specs type: #'unsigned int*'>
>  	<var: #indexPtr type: #'unsigned int*'>
> - 	<var: #subIndex type: #'unsigned int'>
>  	<inline: false>
>  	| registerType spec atomic isInt recurse subLevel |
>  	registerType := initialRegisterType.
>  	[indexPtr at: 0 put: (indexPtr at: 0) + 1.
>  	subLevel := 0.
>  	(indexPtr at: 0) < specSize]
>  		whileTrue:
>  			[spec := specs at: (indexPtr at: 0).
>  			isInt := false.
>  			recurse := false.
>  			spec = FFIFlagStructure "this marks end of structure/union"
>  				ifTrue:
>  					[subLevel = 0 ifTrue: [^registerType].
>  					subLevel := subLevel - 1]
>  				ifFalse:
>  					[(spec anyMask: FFIFlagPointer)
>  						ifTrue:
>  							[isInt := true]
>  						ifFalse:
>  							[(spec bitAnd: FFIFlagStructure + FFIFlagAtomic)
>  								caseOf:
>  									{[FFIFlagStructure] ->
>  										[recurse := (self isUnionSpec: specs OfLength: specSize StartingAt: (indexPtr at: 0))not.
>  										recurse ifFalse: [subLevel := subLevel + 1]].
>  									[FFIFlagAtomic] ->
>  										[atomic := self atomicTypeOf: spec.
>  										isInt := (atomic >> 1) ~= (FFITypeSingleFloat >> 1)]}
>  								otherwise: ["invalid spec" ^-1]].
>  					isInt
>  						ifTrue:
>  							["If this eightbyte contains an int field, then we must use an int register"
>  							registerType := registerType bitOr: 1 << eightbyteOffset].
>  					recurse ifTrue:
>  						["struct in union require a recursive form, because we handle byteOffset/eightbyteOffset differently"
>  						registerType := self
>  								registerType: registerType
>  								ForStructSpecs: specs
>  								OfLength: specSize
>  								StartingAt: indexPtr
>  								ByteOffset: byteOffset
>  								EightbyteOffset: eightbyteOffset]]].
>  	self assert: subLevel = 0.
>  	^registerType!
>
> Item was changed:
>  ----- Method: ThreadedX64SysVFFIPlugin>>registerTypeForStructSpecs:OfLength: (in category 'marshalling') -----
>  registerTypeForStructSpecs: specs OfLength: specSize
>  	"Answer with a number characterizing the register type for passing a struct of size <= 16 bytes.
>  	The bit at offset i of registerType is set to 1 if eightbyte at offset i is a int register (RAX ...)
>  	The bit at offset 2 indicates if there is a single eightbyte (struct size <= 8)
>  	* 2r00 for float float (XMM0 XMM1)
>  	* 2r01 for int float (RAX XMM0)
>  	* 2r10 for float int (XMM0 RAX)
>  	* 2r11 for int int (RAX RDX)
>  	* 2r100 for float (XMM0)
>  	* 2r101 for int (RAX)
>  	* 2r110 INVALID (not aligned)
>  	Beware, the bits must be read from right to left for decoding register type.
>  	Note: this method reconstructs the struct layout according to X64 alignment rules.
>  	Therefore, it will not work for packed struct or other exotic alignment."
>
>  	<var: #specs type: #'unsigned int*'>
> - 	<var: #subIndex type: #'unsigned int'>
>  	<inline: false>
>  	| index byteSize registerType |
>  	index := 0.
>  	byteSize := (specs at: index) bitAnd: FFIStructSizeMask.
>  	byteSize > 16 ifTrue: [^2r110].
>  	(self checkAlignmentOfStructSpec: specs OfLength: specSize StartingAt: index)
>  		ifFalse: [^2r110].
>  	registerType := byteSize <= 8 ifTrue: [2r100] ifFalse: [0].
>  	^(self isUnionSpec: specs OfLength: specSize StartingAt: 0)
>  		ifTrue: [ self
>  			registerType: registerType
>  			ForUnionSpecs: specs
>  			OfLength: specSize
>  			StartingAt: (self addressOf: index)
>  			ByteOffset: 0
>  			EightbyteOffset: 0 ]
>  		ifFalse: [ self
>  			registerType: registerType
>  			ForStructSpecs: specs
>  			OfLength: specSize
>  			StartingAt: (self addressOf: index)
>  			ByteOffset: 0
>  			EightbyteOffset: 0 ]!
>
> Item was changed:
>  ----- Method: VMMaker class>>generateVMPlugins (in category 'configurations') -----
>  generateVMPlugins
>  	^VMMaker
>  		generatePluginsTo: self sourceTree, '/src'
>  		options: #()
>  		platformDir: self sourceTree, '/platforms'
>  		including:#(ADPCMCodecPlugin AsynchFilePlugin
>  					BalloonEnginePlugin B3DAcceleratorPlugin B3DEnginePlugin BMPReadWriterPlugin BitBltSimulation
>  					BochsIA32Plugin BochsX64Plugin GdbARMv6Plugin GdbARMv8Plugin
>  					CameraPlugin CroquetPlugin DeflatePlugin DropPlugin
> + 					"Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin
> - 					"Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin SHA256Plugin
>  					"FT2Plugin" FFTPlugin FileCopyPlugin FilePlugin FileAttributesPlugin Float64ArrayPlugin FloatArrayPlugin FloatMathPlugin
>  					GeniePlugin HostWindowPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin
>  					JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin
>  					LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin
>  					MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin
>  					ScratchPlugin SecurityPlugin SerialPlugin SocketPlugin
>  					SoundCodecPlugin SoundGenerationPlugin SoundPlugin SqueakSSLPlugin StarSqueakPlugin
>  					ThreadedFFIPlugin ThreadedARM32FFIPlugin ThreadedARM64FFIPlugin ThreadedIA32FFIPlugin
>  					ThreadedX64SysVFFIPlugin ThreadedX64Win64FFIPlugin
>  					UnicodePlugin UnixAioPlugin UUIDPlugin UnixOSProcessPlugin
>  					Win32OSProcessPlugin VMProfileLinuxSupportPlugin VMProfileMacSupportPlugin WeDoPlugin
>  					XDisplayControlPlugin)!


More information about the Vm-dev mailing list