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

commits at source.squeak.org commits at source.squeak.org
Thu Jun 25 22:03:11 UTC 2020


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

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

Name: VMMaker.oscog-eem.2762
Author: eem
Time: 25 June 2020, 3:02:53.797793 pm
UUID: 4c244387-7f00-429e-8c37-1524f9397177
Ancestors: VMMaker.oscog-eem.2761

Merge VMMaker.oscog-ul.2763
add missing SHA2Plugin to the list of plugins

=============== 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 SHA2Plugin
- 					"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