[Vm-dev] VM Maker: VMMaker-dtl.438.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Jan 16 16:46:34 UTC 2023


David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.438.mcz

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

Name: VMMaker-dtl.438
Author: dtl
Time: 16 January 2023, 11:35:57.177 am
UUID: f3c8ffc2-b498-43c5-8a94-c10c6d2eb68e
Ancestors: VMMaker-dtl.437

VMMaker 4.20.4 updates to enable slang generation from Squeak 6

Rescue primitiveStringHash from ByteArray class>>hashBytes:startingWith: which is no longer translatable as of Squeak 6. Copy the implementation from Squeak4.6 to MiscPrimitivePlugin class>>hashBytes:startingWith:

Implement fixWellKnownSends: as mechanism for translating SmallInteger maxVal as now found in an included method for SoundGenerationPlugin in Squeak 6. Do not use the mapSendsFromSelfToInterpreterProxy: mechanism from oscog 
because this depends on generating additional macros to the interp.h header (but may need to move to mapSendsFromSelfToInterpreterProxy: in future as it is more extensively used in oscog).

Fix TSendNode>>printOn:level: to prevent failure on cairo method selectors from RomePlugin, required for the fixWellKnownSends: implementation if RomePlugin is being generated.

Add tests to IncludedMethodsTest for additional coverage.

=============== Diff against VMMaker-dtl.437 ===============

Item was changed:
  ----- Method: CCodeGenerator>>addMethodsForPrimitives: (in category 'public') -----
  addMethodsForPrimitives: classAndSelectorList 
  	| sel aClass source verbose meth |
  	classAndSelectorList do:[:classAndSelector | 
  		aClass := Smalltalk at: (classAndSelector at: 1) ifAbsent:[nil].
  		aClass ifNotNil:[
  			self addAllClassVarsFor: aClass.
  			"TPR - should pool vars also be added here?"
  
  			"find the method in either the class or the metaclass"
  			sel := classAndSelector at: 2.
  			(aClass includesSelector: sel)
  				ifTrue: [source := aClass sourceCodeAt: sel ifAbsent:[nil]]
  				ifFalse: [source := aClass class sourceCodeAt: sel ifAbsent:[nil]].
  		].
  		source ifNil:[
  			Transcript cr; show: 'WARNING: Compiled primitive ', classAndSelector first, '>>', classAndSelector last, ' not present'.
  		] ifNotNil:[
  			"compile the method source and convert to a suitable translation 
  			method "
  			meth := (Compiler new
  						parse: source
  						in: aClass
  						notifying: nil)
  						asTranslationMethodOfClass: self translationMethodClass.
  
  			(aClass includesSelector: sel)
  				ifTrue: [meth definingClass: aClass]
  				ifFalse: [meth definingClass: aClass class].
  			meth primitive > 0 ifTrue:[meth preparePrimitiveName].
  			"for old-style array accessing: 
  			meth covertToZeroBasedArrayReferences."
  			meth replaceSizeMessages.
  			self addMethod: meth.
  		].
  	].
  	"method preparation"
  	verbose := false.
  	self prepareMethods.
  	verbose
  		ifTrue: 
  			[self printUnboundCallWarnings.
  			self printUnboundVariableReferenceWarnings.
  			Transcript cr].
  
  	"code generation"
  	self doInlining: true.
  
  	methods do:[:m|
+ 		m fixWellKnownSends: self objectMemoryClass.
  		"if this method is supposed to be a primitive (rather than a helper 
  		routine), add assorted prolog and epilog items"
  		m primitive > 0 ifTrue: [m preparePrimitivePrologue]].!

Item was changed:
  ----- Method: CCodeGenerator>>emitCCodeOn:doInlining:doAssertions: (in category 'C code generator') -----
  emitCCodeOn: aStream doInlining: inlineFlag doAssertions: assertionFlag
  	"Emit C code for all methods in the code base onto the given stream. All inlined method calls should already have been expanded."
  
+ 	(self prepareMethodsInlined: inlineFlag doAssertions: assertionFlag)
+ 		do: [ :m | m fixWellKnownSends: self objectMemoryClass ].
- 	self prepareMethodsInlined: inlineFlag doAssertions: assertionFlag.
  	^ self emitCCodeOn: aStream doAssertions: assertionFlag
  !

Item was added:
+ ----- Method: CCodeGenerator>>objectMemoryClass (in category 'composition') -----
+ objectMemoryClass
+ 	"A class that provides certain memory format constants. Reference the related
+ 	facade mechanism in oscog for Spur support. Ideally this could be tied to the composition
+ 	of interpreter and object memory when building the code generator."
+ 
+ 	^ ObjectMemory!

Item was added:
+ ----- Method: IncludedMethodsTest>>encodeBytesOf:in:at: (in category 'primitive fallback code') -----
+ encodeBytesOf: anInt in: ba at: i
+ 	"Copy the integer anInt into byteArray ba at index i, and return the next index"
+ 
+ 	0 to: 3 do:
+ 		[:j | ba at: i+j put: (anInt >> (3-j*8) bitAnd: 16rFF)].
+ 	^ i+4!

Item was added:
+ ----- Method: IncludedMethodsTest>>encodeInt:in:at: (in category 'primitive fallback code') -----
+ encodeInt: anInt in: ba at: i
+ 	"Encode the integer anInt in byteArray ba at index i, and return the next index.
+ 	The encoding is as follows...
+ 		0-223	0-223
+ 		224-254	(0-30)*256 + next byte (0-7935)
+ 		255		next 4 bytes"		
+ 
+ 	anInt <= 223 ifTrue: [ba at: i put: anInt. ^ i+1].
+ 	anInt <= 7935 ifTrue: [ba at: i put: anInt//256+224. ba at: i+1 put: anInt\\256.  ^ i+2].
+ 	ba at: i put: 255.
+ 	^ self encodeBytesOf: anInt in: ba at: i+1!

Item was added:
+ ----- Method: IncludedMethodsTest>>fallbackCompare:with:collated: (in category 'primitive fallback code') -----
+ fallbackCompare: string1 with: string2 collated: order
+ 	"Implementation of ByteString>>compare:with:collated: without the primitive call"
+ 
+ 	| len1 len2 c1 c2 |
+ 	len1 := string1 size.
+ 	len2 := string2 size.
+ 	1 to: (len1 min: len2) do:
+ 		[:i |
+ 		c1 := order at: (string1 basicAt: i) + 1.
+ 		c2 := order at: (string2 basicAt: i) + 1.
+ 		c1 = c2 ifFalse: 
+ 			[c1 < c2 ifTrue: [^ 1] ifFalse: [^ 3]]].
+ 	len1 = len2 ifTrue: [^ 2].
+ 	len1 < len2 ifTrue: [^ 1] ifFalse: [^ 3].
+ !

Item was added:
+ ----- Method: IncludedMethodsTest>>fallbackCompress:toByteArray: (in category 'primitive fallback code') -----
+ fallbackCompress: bm toByteArray: ba
+ 	"Implementation of BitMap>>compress:toByteArray: without the primitive call"		
+ 	| size k word j lowByte eqBytes i |
+ 	size := bm size.
+ 	i := self encodeInt: size in: ba at: 1.
+ 	k := 1.
+ 	[k <= size] whileTrue:
+ 		[word := bm at: k.
+ 		lowByte := word bitAnd: 16rFF.
+ 		eqBytes := ((word >> 8) bitAnd: 16rFF) = lowByte
+ 				and: [((word >> 16) bitAnd: 16rFF) = lowByte
+ 				and: [((word >> 24) bitAnd: 16rFF) = lowByte]].
+ 		j := k.
+ 		[j < size and: [word = (bm at: j+1)]]  "scan for = words..."
+ 			whileTrue: [j := j+1].
+ 		j > k ifTrue:
+ 			["We have two or more = words, ending at j"
+ 			eqBytes
+ 				ifTrue: ["Actually words of = bytes"
+ 						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:
+ 			["Check for word of 4 = bytes"
+ 			eqBytes ifTrue:
+ 				["Note 1 word of 4 = bytes"
+ 				i := self encodeInt: 1*4+1 in: ba at: i.
+ 				ba at: i put: lowByte.  i := i+1.
+ 				k := k + 1]
+ 				ifFalse:
+ 				["Finally, check for junk"
+ 				[j < size and: [(bm at: j) ~= (bm at: j+1)]]  "scan for ~= words..."
+ 					whileTrue: [j := j+1].
+ 				j = size ifTrue: [j := j + 1].
+ 				"We have one or more unmatching words, ending at j-1"
+ 				i := self encodeInt: j-k*4+3 in: ba at: i.
+ 				k to: j-1 do:
+ 					[:m | i := self encodeBytesOf: (bm at: m) in: ba at: i].
+ 				k := j]]].
+ 	^ i - 1  "number of bytes actually stored"
+ "
+ Space check:
+  | n rawBytes myBytes b |
+ n := rawBytes := myBytes := 0.
+ Form allInstancesDo:
+ 	[:f | f unhibernate.
+ 	b := f bits.
+ 	n := n + 1.
+ 	rawBytes := rawBytes + (b size*4).
+ 	myBytes := myBytes + (b compressToByteArray size).
+ 	f hibernate].
+ Array with: n with: rawBytes with: myBytes
+ ColorForms: (116 230324 160318 )
+ Forms: (113 1887808 1325055 )
+ 
+ Integerity check:
+ Form allInstances do:
+ 	[:f | f unhibernate.
+ 	f bits = (Bitmap decompressFromByteArray: f bits compressToByteArray)
+ 		ifFalse: [self halt].
+ 	f hibernate]
+ 
+ Speed test:
+ MessageTally spyOn: [Form allInstances do:
+ 	[:f | Bitmap decompressFromByteArray: f bits compressToByteArray]]
+ "!

Item was added:
+ ----- Method: IncludedMethodsTest>>fallbackDecompress:fromByteArray:at: (in category 'primitive fallback code') -----
+ fallbackDecompress: bm fromByteArray: ba at: index
+ 	"Implementation of BitMap>>decompress:fromByteArray:at: without the primitive call"	
+ 	| i code n anInt data end k pastEnd |
+ 	i := index.  "byteArray read index"
+ 	end := ba size.
+ 	k := 1.  "bitmap write index"
+ 	pastEnd := bm size + 1.
+ 	[i <= end] whileTrue:
+ 		["Decode next run start N"
+ 		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 do: [:j | anInt := (anInt bitShift: 8) + (ba at: i).  i := i+1]]].
+ 		n := anInt >> 2.
+ 		(k + n) > pastEnd ifTrue: [^ self primitiveFail].
+ 		code := anInt bitAnd: 3.
+ 		code = 0 ifTrue: ["skip"].
+ 		code = 1 ifTrue: ["n consecutive words of 4 bytes = the following byte"
+ 						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: ["n consecutive words = 4 following bytes"
+ 						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: ["n consecutive words from the data..."
+ 						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]]]!

Item was added:
+ ----- Method: IncludedMethodsTest>>fallbackFindFirstInString:inSet:startingAt: (in category 'primitive fallback code') -----
+ fallbackFindFirstInString: aString  inSet: inclusionMap  startingAt: start
+ 	"Implementation of ByteString>>findFirstInString:inSet:startingAt: without the primitive call"
+ 
+ 	| i stringSize |
+ 
+ 	inclusionMap size ~= 256 ifTrue: [ ^0 ].
+ 
+ 	i := start.
+ 	stringSize := aString size.
+ 	[ i <= stringSize and: [ (inclusionMap at: (aString at: i) asciiValue+1) = 0 ] ] whileTrue: [ 
+ 		i := i + 1 ].
+ 
+ 	i > stringSize ifTrue: [ ^0 ].
+ 	^i!

Item was added:
+ ----- Method: IncludedMethodsTest>>fallbackFindSubstring:in:startingAt:matchTable: (in category 'primitive fallback code') -----
+ fallbackFindSubstring: key in: body startingAt: start matchTable: matchTable
+ 	"Implementation of ByteString>>findSubstring:in:startingAt:matchTable: without the primitive call"
+ 	| index |
+ 	key size = 0 ifTrue: [^ 0].
+ 	(start max: 1) to: body size - key size + 1 do:
+ 		[:startIndex |
+ 		index := 1.
+ 			[(matchTable at: (body at: startIndex+index-1) asciiValue + 1)
+ 				= (matchTable at: (key at: index) asciiValue + 1)]
+ 				whileTrue:
+ 				[index = key size ifTrue: [^ startIndex].
+ 				index := index+1]].
+ 	^ 0
+ !

Item was added:
+ ----- Method: IncludedMethodsTest>>fallbackHashBytes:startingWith: (in category 'primitive fallback code') -----
+ fallbackHashBytes: aByteArray startingWith: speciesHash
+ 	"Implementation of ByteArray class>>hashBytes:startingWith: without the primitive call"
+ 
+ 	| byteArraySize hash low |
+ 
+ 	byteArraySize := aByteArray size.
+ 	hash := speciesHash bitAnd: 16rFFFFFFF.
+ 	1 to: byteArraySize do: [:pos |
+ 		hash := hash + (aByteArray basicAt: pos).
+ 		"Begin hashMultiply"
+ 		low := hash bitAnd: 16383.
+ 		hash := (16r260D * low + ((16r260D * (hash bitShift: -14) + (16r0065 * low) bitAnd: 16383) * 16384)) bitAnd: 16r0FFFFFFF.
+ 	].
+ 	^ hash!

Item was added:
+ ----- Method: IncludedMethodsTest>>fallbackIndexOfAscii:inString:startingAt: (in category 'primitive fallback code') -----
+ fallbackIndexOfAscii: anInteger inString: aString startingAt: start
+ 	"Implementation of ByteString>>indexOfAscii:inString:startingAt: without the primitive call"
+ 	| stringSize |
+ 	stringSize := aString size.
+ 	start to: stringSize do: [:pos |
+ 		(aString at: pos) asciiValue = anInteger ifTrue: [^ pos]].
+ 
+ 	^ 0
+ !

Item was added:
+ ----- Method: IncludedMethodsTest>>fallbackTranslate:from:to:table: (in category 'primitive fallback code') -----
+ fallbackTranslate: aString from: start  to: stop  table: table
+ 	"Implementation of ByteString>>translate:from:to:table: without the primitive call"
+ 
+ 	start to: stop do: [ :i |
+ 		aString at: i put: (table at: (aString at: i) asciiValue+1) ]!

Item was changed:
  ----- Method: IncludedMethodsTest>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'primitives') -----
  mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol
+ 	"Mix the given number of samples with the samples already in the given buffer starting at the given index. Assume that the buffer size is at least (index + count) - 1."
- 	"Play samples from a wave table by stepping a fixed amount through the table on every sample. The table index and increment are scaled to allow fractional increments for greater pitch accuracy."
- 	"(FMSound pitch: 440.0 dur: 1.0 loudness: 0.5) play"
  
+ 	<primitive:'primitiveMixSampledSound' module:'SoundGenerationPlugin'>
+ 	^self primitiveFailed.
+ 
- 	<primitive:'primitiveMixFMSound' module:'SoundGenerationPlugin'>
- 	self primitiveFailed
  !

Item was changed:
  ----- Method: IncludedMethodsTest>>testCompareWithCollated (in category 'testing - MiscPrimitivePlugin') -----
  testCompareWithCollated
  	"Verify that primitive exists in the VM"
  
+ 	self assert: 1 equals: (self compare: 'bar' with: 'foo' collated: ((0 to: 255) as: ByteArray)).
+ 	self assert: 2 equals: (self compare: 'foo' with: 'foo' collated: ((0 to: 255) as: ByteArray)).
+ 	self assert: 3 equals: (self compare: 'foo' with: 'bar' collated: ((0 to: 255) as: ByteArray)).
+ 
+ 	self assert: 1 equals: (self fallbackCompare: 'bar' with: 'foo' collated: ((0 to: 255) as: ByteArray)).
+ 	self assert: 2 equals: (self fallbackCompare: 'foo' with: 'foo' collated: ((0 to: 255) as: ByteArray)).
+ 	self assert: 3 equals: (self fallbackCompare: 'foo' with: 'bar' collated: ((0 to: 255) as: ByteArray)).
- 	self assert: 3 = (self compare: 'foo' with: 'bar' collated: ((0 to: 255) as: ByteArray))
  !

Item was changed:
  ----- Method: IncludedMethodsTest>>testCompressToByteArray (in category 'testing - MiscPrimitivePlugin') -----
  testCompressToByteArray
  
  	| bitmap byteArray |
  	bitmap := Bitmap with: 16rFFFFFFFF.
  	byteArray := ByteArray new:  4.
  	self compress: bitmap toByteArray: byteArray.
+ 	self assert: #[1 5 255 0] equals: byteArray.
+ 
+ 	byteArray := ByteArray new:  4.
+ 	self fallbackCompress: bitmap toByteArray: byteArray.
+ 	self assert: #[1 5 255 0] equals: byteArray.
+ 
+ 	bitmap := Bitmap with: 16r12345678.
+ 	byteArray := ByteArray new:  6.
+ 	self compress: bitmap toByteArray: byteArray.
+ 	self assert: #[1 7 18 52 86 120] equals: byteArray.
+ 
+ 	byteArray := ByteArray new:  6.
+ 	self fallbackCompress: bitmap toByteArray: byteArray.
+ 	self assert: #[1 7 18 52 86 120] equals: byteArray.
+ !
- 	self should: byteArray = #[1 5 255 0]!

Item was changed:
  ----- Method: IncludedMethodsTest>>testDecompressFromByteArrayAt (in category 'testing - MiscPrimitivePlugin') -----
  testDecompressFromByteArrayAt
  
  	| bitmap byteArray s size |
  	byteArray := #(1 5 255  0) asByteArray.
  	s := ReadStream on: byteArray.
  	size := Bitmap decodeIntFrom: s.
  	bitmap := Bitmap new: size.
  	self decompress: bitmap fromByteArray: byteArray at: s position + 1.
+ 	self should: bitmap = ((Bitmap new: 1) at: 1 put: 4294967295; yourself).
+ 
+ 	s := ReadStream on: byteArray.
+ 	size := Bitmap decodeIntFrom: s.
+ 	bitmap := Bitmap new: size.
+ 	self fallbackDecompress: bitmap fromByteArray: byteArray at: s position + 1.
+ 	self should: bitmap = ((Bitmap new: 1) at: 1 put: 4294967295; yourself).!
- 	self should: bitmap = ((Bitmap new: 1) at: 1 put: 4294967295; yourself)!

Item was changed:
  ----- Method: IncludedMethodsTest>>testFindFirstInStringInSetStartingAt (in category 'testing - MiscPrimitivePlugin') -----
  testFindFirstInStringInSetStartingAt
  
  	| position set |
  	set := ((0 to: 255) collect: [:e | (e \\ 2) + $0 asciiValue]) asByteArray.
+ 
  	position := self findFirstInString: 'abcdef' inSet: set startingAt: 1.
+ 	self assert: 1 equals: position.
+ 
+ 	position := self fallbackFindFirstInString: 'abcdef' inSet: set startingAt: 1.
+ 	self assert: 1 equals: position.
- 	self assert: position = 1
  !

Item was changed:
  ----- Method: IncludedMethodsTest>>testFindSubstring (in category 'testing - MiscPrimitivePlugin') -----
  testFindSubstring
  	"Verify that primitive exists in the VM and that non byte array arguments cause primitive to fail"
  
  	| position |
+ 	position := self
- 	position := IncludedMethodsTest new
  				findSubstring: 'bc'
  				in: 'abcdef'
  				startingAt: 1
  				matchTable: ((0 to: 255)
  						as: ByteArray).
+ 	self assert: 2 equals: position.
+ 	self should: [self
- 	self assert: position = 2.
- 	self should: [IncludedMethodsTest new
  				findSubstring: 'bc' asWideString
  				in: 'abcdef'
  				startingAt: 1
  				matchTable: ((0 to: 255)
  						as: ByteArray)]
  					raise: Error.
+ 	self should: [self
- 	self should: [IncludedMethodsTest new
  				findSubstring: 'bc'
  				in: 'abcdef' asWideString
  				startingAt: 1
  				matchTable: ((0 to: 255)
  						as: ByteArray)]
  					raise: Error.
+ 	self should: [self
- 	self should: [IncludedMethodsTest new
  				findSubstring: 'bc' asWideString
  				in: 'abcdef' asWideString
  				startingAt: 1
  				matchTable: ((0 to: 255)
  						as: ByteArray)]
+ 					raise: Error.
+ 
+ 
+ 	position := self
+ 				fallbackFindSubstring: 'bc'
+ 				in: 'abcdef'
+ 				startingAt: 1
+ 				matchTable: ((0 to: 255)
+ 						as: ByteArray).
+ 	self assert: 2 equals: position.
- 					raise: Error
  !

Item was changed:
  ----- Method: IncludedMethodsTest>>testHashBytesStartingWith (in category 'testing - MiscPrimitivePlugin') -----
  testHashBytesStartingWith
  
+ 	| ba lpi result |
- 	| ba result |
  	ba := #[1 2 3 4 5 6 7 8 9].
  	result := self hashBytes: ba startingWith: 12345.
+ 	self assert: result = 170953102.
+ 	result := self fallbackHashBytes: ba startingWith: 12345.
+ 	self assert: result = 170953102.
+ 
+ 	ba := #[].
+ 	result := self hashBytes: ba startingWith: 12345.
+ 	self assert: result = 12345.
+ 	result := self fallbackHashBytes: ba startingWith: 12345.
+ 	self assert: result = 12345.
+ 
+ 	ba := #[ 0 ].
+ 	result := self hashBytes: ba startingWith: 12345.
+ 	self assert: result = 147466469.
+ 	result := self fallbackHashBytes: ba startingWith: 12345.
+ 	self assert: result = 147466469.
+ 
+ 	lpi := 12345678901234567890.
+ 	result := self hashBytes: lpi startingWith: 12345.
+ 	self assert: result = 237468655.
+ 	result := self fallbackHashBytes: lpi startingWith: 12345.
+ 	self assert: result = 237468655.
+ 
+ 
+ 
- 	self assert: result = 170953102
  !

Item was changed:
  ----- Method: IncludedMethodsTest>>testIindexOfAsciiInStringStartingAt (in category 'testing - MiscPrimitivePlugin') -----
  testIindexOfAsciiInStringStartingAt
  
  	| position |
  	position := self indexOfAscii: 50 inString: '012345' startingAt: 1.
+ 	self assert: 3 equals: position.
+ 
+ 	position := self fallbackIndexOfAscii: 50 inString: '012345' startingAt: 1.
+ 	self assert: 3 equals: position.
+ !
- 	self assert: position = 3!

Item was changed:
  ----- Method: IncludedMethodsTest>>testTranslateFromToTable (in category 'testing - MiscPrimitivePlugin') -----
  testTranslateFromToTable
  	"Verify that primitive exists in the VM"
  
  	| s t |
  	s := 'foo' copy. "copy so string is instantiated each time"
+ 	t := ByteString withAll: ((1 to: 255) as: ByteArray).
- 	t := ByteArray withAll: ((1 to: 255) as: ByteArray).
  	self translate: s from: 1 to: 3 table: t.
+ 	self assert: 'gpp' equals: s.
+ 
+ 	s := 'foo' copy. "copy so string is instantiated each time"
+ 	t := ByteString withAll: ((1 to: 255) as: ByteArray).
+ 	self fallbackTranslate: s from: 1 to: 3 table: t.
+ 	self assert: 'gpp' equals: s.
- 	self assert: s = 'gpp'
  !

Item was added:
+ ----- Method: MiscPrimitivePlugin class>>hashBytes:startingWith: (in category 'class ByteArray methods') -----
+ hashBytes: aByteArray startingWith: speciesHash
+ 	"Answer the hash of a byte-indexed collection,
+ 	using speciesHash as the initial value.
+ 	See SmallInteger>>hashMultiply.
+ 
+ 	The primitive should be renamed at a
+ 	suitable point in the future"
+ 
+ 	| byteArraySize hash low |
+ 	<primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'>
+ 	<var: #aHash declareC: 'int speciesHash'>
+ 	<var: #aByteArray declareC: 'unsigned char *aByteArray'>
+ 
+ 	byteArraySize := aByteArray size.
+ 	hash := speciesHash bitAnd: 16rFFFFFFF.
+ 	1 to: byteArraySize do: [:pos |
+ 		hash := hash + (aByteArray basicAt: pos).
+ 		"Begin hashMultiply"
+ 		low := hash bitAnd: 16383.
+ 		hash := (16r260D * low + ((16r260D * (hash bitShift: -14) + (16r0065 * low) bitAnd: 16383) * 16384)) bitAnd: 16r0FFFFFFF.
+ 	].
+ 	^ hash!

Item was changed:
  ----- Method: MiscPrimitivePlugin class>>translatedPrimitives (in category 'translation') -----
  translatedPrimitives
  	"an assorted list of various primitives"
  	^#(
  		(Bitmap compress:toByteArray:)
  		(Bitmap decompress:fromByteArray:at:)
  		(Bitmap encodeBytesOf:in:at:)
  		(Bitmap encodeInt:in:at:)
  		(ByteString compare:with:collated:)
  		(ByteString translate:from:to:table:)	
  		(ByteString findFirstInString:inSet:startingAt:)
  		(ByteString indexOfAscii:inString:startingAt:)
  		(ByteString findSubstring:in:startingAt:matchTable:)
+ 		(MiscPrimitivePlugin hashBytes:startingWith:) "was (ByteArray hashBytes:startingWith:)"
- 		(ByteArray hashBytes:startingWith:)
  		(SampledSound convert8bitSignedFrom:to16Bit:)
  	)
  
  	"| tps |
  	'This opens a list browser on all translated primitives in the image'.
  	 tps := (SystemNavigation default allImplementorsOf: #translatedPrimitives)
  				inject: Set new
  				into: [:tp :mr|
  					tp addAll: (mr actualClass theNonMetaClass translatedPrimitives collect:
  								[:pair|
  								MethodReference
  									class: (((Smalltalk at: pair first) canUnderstand: pair last)
  												ifTrue: [Smalltalk at: pair first]
  												ifFalse: [(Smalltalk at: pair first) class])
  									selector: pair last]);
  						yourself].
  	SystemNavigation default browseMessageList: tps asArray sort name: 'Translated Primitives' "!

Item was added:
+ ----- Method: ObjectMemory class>>maxSmallInteger (in category 'translation') -----
+ maxSmallInteger
+ 	^1073741823!

Item was added:
+ ----- Method: ObjectMemory class>>minSmallInteger (in category 'translation') -----
+ minSmallInteger
+ 	^-1073741824!

Item was added:
+ ----- Method: TMethod>>fixWellKnownSends: (in category 'transformations') -----
+ fixWellKnownSends: memoryFormatClass
+ 	"Certain trivial sends can be mapped to defines in the generated header files.
+ 	For reference see TMethod>>mapSendsFromSelfToInterpreterProxy: in oscog branch"
+ 
+ 	parseTree nodesDo:
+ 		[:node|
+ 		(node isSend and: [node receiver isVariable])
+ 			ifTrue: [(node name
+ 						caseOf: {
+ 							[ 'SmallInteger minVal' ] -> [ TConstantNode new setValue: memoryFormatClass minSmallInteger ].
+ 							[ 'SmallInteger maxVal' ] -> [ TConstantNode new setValue: memoryFormatClass maxSmallInteger ]
+ 							}
+ 						otherwise: [nil])
+ 				ifNotNil: [ :replacement | replacement ifNotNil: [ node becomeForward: replacement ]]]].
+ !

Item was changed:
  ----- Method: TSendNode>>printOn:level: (in category 'printing') -----
  printOn: aStream level: level
  	| possiblyParenthesize |
  	possiblyParenthesize :=
  		[:node :newLevel|
  		(node isSend
  		 and: [node selector precedence >= 3]) ifTrue:
  			[aStream nextPut: $(].
  		node printOn: aStream level: newLevel.
  		(node isSend
  		 and: [node selector precedence >= 3]) ifTrue:
  			[aStream nextPut: $)]].
  
  	possiblyParenthesize value: receiver value: level.
  	arguments size = 0 ifTrue:
  		[aStream space; nextPutAll: selector.
  		^self].
+ 	selector keywords with: (arguments first: selector keywords size) do:
- 	selector keywords with: (arguments first: selector numSelectorArgs) do:
  		[:keyword :arg |
  		arg ifNotNil: [
  			aStream space; nextPutAll: keyword; space.
  			possiblyParenthesize value: arg value: level + 1]]!

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
  
  	"VMMaker versionString"
  
+ 	^'4.20.4'!
- 	^'4.20.3'!



More information about the Vm-dev mailing list