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

commits at source.squeak.org commits at source.squeak.org
Sat Jul 19 00:27:59 UTC 2014 

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

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

Name: VMMaker.oscog-eem.826
Author: eem
Time: 18 July 2014, 5:25:22.251 pm
UUID: baaa71a3-d71b-4656-be88-ecc3e7b6afe5
Ancestors: VMMaker.oscog-eem.825

Fix the ZipPlugin (InflatePlugin&DeflatePlugin) to no longer
depend on specific instance sizes for ReadStream and
WriteStream which allows some leniency in redefining these
classes.

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

Item was changed:
  InflatePlugin subclass: #DeflatePlugin
+ 	instanceVariableNames: 'zipHashHead zipHashTail zipHashValue zipBlockPos zipBlockStart zipLiterals zipDistances zipLiteralFreq zipDistanceFreq zipLiteralCount zipLiteralSize zipMatchCount zipMatchLengthCodes zipDistanceCodes zipCrcTable zipExtraLengthBits zipExtraDistanceBits zipBaseLength zipBaseDistance writeStreamInstSize'
- 	instanceVariableNames: 'zipHashHead zipHashTail zipHashValue zipBlockPos zipBlockStart zipLiterals zipDistances zipLiteralFreq zipDistanceFreq zipLiteralCount zipLiteralSize zipMatchCount zipMatchLengthCodes zipDistanceCodes zipCrcTable zipExtraLengthBits zipExtraDistanceBits zipBaseLength zipBaseDistance'
  	classVariableNames: 'DeflateHashBits DeflateHashMask DeflateHashShift DeflateHashTableSize DeflateMaxDistance DeflateMaxDistanceCodes DeflateMaxLiteralCodes DeflateMaxMatch DeflateMinMatch DeflateWindowMask DeflateWindowSize'
  	poolDictionaries: ''
  	category: 'VMMaker-Plugins'!
  
  !DeflatePlugin commentStamp: 'tpr 5/5/2003 11:52' prior: 0!
  This adds Zip deflating support.
  InflatePlugin should not be translated but this subclass should since it is incorporated within that class's translation process!

Item was added:
+ ----- Method: DeflatePlugin>>determineSizeOfWriteStream: (in category 'primitive support') -----
+ determineSizeOfWriteStream: rcvr
+ 	"Determine the inst size of the class above DeflateStream or
+ 	 ZipEncoder by looking for the first class whose inst size is less than 7."
+ 	| class |
+ 	class := interpreterProxy fetchClassOf: rcvr.
+ 	[class ~= interpreterProxy nilObject
+ 	 and: [(interpreterProxy instanceSizeOf: class) >= 7]] whileTrue:
+ 		[class := interpreterProxy superclassOf: class].
+ 	class = interpreterProxy nilObject ifTrue:
+ 		[^false].
+ 	writeStreamInstSize := interpreterProxy instanceSizeOf: class.
+ 	^true
+ !

Item was added:
+ ----- Method: DeflatePlugin>>initialize (in category 'initialize-release') -----
+ initialize
+ 	writeStreamInstSize := 0!

Item was changed:
  ----- Method: DeflatePlugin>>loadDeflateStreamFrom: (in category 'primitive support') -----
  loadDeflateStreamFrom: rcvr
  	| oop |
  	<inline: false>
  	((interpreterProxy isPointers: rcvr)
  	 and: [(interpreterProxy slotSizeOf: rcvr) >= 15]) ifFalse:
  		[^false].
  	oop := interpreterProxy fetchPointer: 0 ofObject: rcvr.
  	(interpreterProxy isBytes: oop) ifFalse:
  		[^false].
+ 	writeStreamInstSize = 0 ifTrue:
+ 		[(self determineSizeOfWriteStream: rcvr) ifFalse:
+ 			[^false].
+ 		 "If the receiver wasn't valid then we derived writeStreamInstSize from an invalid source.  discard it."
+ 		 (interpreterProxy slotSizeOf: rcvr) < (writeStreamInstSize + 5) ifTrue:
+ 			[writeStreamInstSize := 0.
+ 			 ^false]].
  	zipCollection := interpreterProxy firstIndexableField: oop.
  	zipCollectionSize := interpreterProxy byteSizeOf: oop.
  
  	zipPosition := interpreterProxy fetchInteger: 1 ofObject: rcvr.
  	zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr.
  	"zipWriteLimit := interpreterProxy fetchInteger: 3 ofObject: rcvr."
  
+ 	oop := interpreterProxy fetchPointer: writeStreamInstSize + 0 ofObject: rcvr.
- 	oop := interpreterProxy fetchPointer: 4 ofObject: rcvr.
  	((interpreterProxy isWords: oop)
  	 and: [(interpreterProxy slotSizeOf: oop) = DeflateHashTableSize]) ifFalse:
  		[^false].
  	zipHashHead := interpreterProxy firstIndexableField: oop.
+ 	oop := interpreterProxy fetchPointer: writeStreamInstSize + 1 ofObject: rcvr.
- 	oop := interpreterProxy fetchPointer: 5 ofObject: rcvr.
  	((interpreterProxy isWords: oop)
  	 and: [(interpreterProxy slotSizeOf: oop) = DeflateWindowSize]) ifFalse:
  		[^false].
  	zipHashTail := interpreterProxy firstIndexableField: oop.
+ 	zipHashValue := interpreterProxy fetchInteger: writeStreamInstSize + 2 ofObject: rcvr.
+ 	zipBlockPos := interpreterProxy fetchInteger: writeStreamInstSize + 3 ofObject: rcvr.
+ 	"zipBlockStart := interpreterProxy fetchInteger: writeStreamInstSize + 4 ofObject: rcvr."
+ 	oop := interpreterProxy fetchPointer: writeStreamInstSize + 5 ofObject: rcvr.
- 	zipHashValue := interpreterProxy fetchInteger: 6 ofObject: rcvr.
- 	zipBlockPos := interpreterProxy fetchInteger: 7 ofObject: rcvr.
- 	"zipBlockStart := interpreterProxy fetchInteger: 8 ofObject: rcvr."
- 	oop := interpreterProxy fetchPointer: 9 ofObject: rcvr.
  	(interpreterProxy isBytes: oop) ifFalse:
  		[^false].
  	zipLiteralSize := interpreterProxy slotSizeOf: oop.
  	zipLiterals := interpreterProxy firstIndexableField: oop.
  
+ 	oop := interpreterProxy fetchPointer: writeStreamInstSize + 6 ofObject: rcvr.
- 	oop := interpreterProxy fetchPointer: 10 ofObject: rcvr.
  	((interpreterProxy isWords: oop)
  	 and: [(interpreterProxy slotSizeOf: oop) >= zipLiteralSize]) ifFalse:
  		[^false].
  	zipDistances := interpreterProxy firstIndexableField: oop.
  
+ 	oop := interpreterProxy fetchPointer: writeStreamInstSize + 7 ofObject: rcvr.
- 	oop := interpreterProxy fetchPointer: 11 ofObject: rcvr.
  	((interpreterProxy isWords: oop)
  	 and: [(interpreterProxy slotSizeOf: oop) = DeflateMaxLiteralCodes]) ifFalse:
  		[^false].
  	zipLiteralFreq := interpreterProxy firstIndexableField: oop.
  
+ 	oop := interpreterProxy fetchPointer: writeStreamInstSize + 8 ofObject: rcvr.
- 	oop := interpreterProxy fetchPointer: 12 ofObject: rcvr.
  	((interpreterProxy isWords: oop)
  	 and: [(interpreterProxy slotSizeOf: oop) = DeflateMaxDistanceCodes]) ifFalse:
  		[^false].
  	zipDistanceFreq := interpreterProxy firstIndexableField: oop.
  
+ 	zipLiteralCount := interpreterProxy fetchInteger: writeStreamInstSize + 9 ofObject: rcvr.
+ 	zipMatchCount := interpreterProxy fetchInteger: writeStreamInstSize + 10 ofObject: rcvr.
- 	zipLiteralCount := interpreterProxy fetchInteger: 13 ofObject: rcvr.
- 	zipMatchCount := interpreterProxy fetchInteger: 14 ofObject: rcvr.
  
  	^interpreterProxy failed not!

Item was changed:
  ----- Method: DeflatePlugin>>loadZipEncoderFrom: (in category 'primitive support') -----
  loadZipEncoderFrom: rcvr
  	| oop |
  	<inline: false>
+ 	writeStreamInstSize = 0 ifTrue:
+ 		[(self determineSizeOfWriteStream: rcvr) ifFalse:
+ 			[^false].
+ 		 "If the receiver wasn't valid then we derived writeStreamInstSize from an invalid source.  discard it."
+ 		 (interpreterProxy slotSizeOf: rcvr) < (writeStreamInstSize + 3) ifTrue:
+ 			[writeStreamInstSize := 0.
+ 			 ^false]].
  	((interpreterProxy isPointers: rcvr)
+ 	 and: [(interpreterProxy slotSizeOf: rcvr) >= (writeStreamInstSize + 3)]) ifFalse:
- 	 and: [(interpreterProxy slotSizeOf: rcvr) >= 6]) ifFalse:
  		[^false].
  	oop := interpreterProxy fetchPointer: 0 ofObject: rcvr.
  	(interpreterProxy isBytes: oop) ifFalse:
  		[^interpreterProxy primitiveFail].
  	zipCollection := interpreterProxy firstIndexableField: oop.
  	zipCollectionSize := interpreterProxy byteSizeOf: oop.
  
  	zipPosition := interpreterProxy fetchInteger: 1 ofObject: rcvr.
  	zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr.
  	"zipWriteLimit := interpreterProxy fetchInteger: 3 ofObject: rcvr."
+ 	zipBitBuf := interpreterProxy fetchInteger: writeStreamInstSize + 1 ofObject: rcvr.
+ 	zipBitPos := interpreterProxy fetchInteger: writeStreamInstSize + 2 ofObject: rcvr.
- 	zipBitBuf := interpreterProxy fetchInteger: 4 ofObject: rcvr.
- 	zipBitPos := interpreterProxy fetchInteger: 5 ofObject: rcvr.
  
  	^interpreterProxy failed not!

Item was changed:
  ----- Method: DeflatePlugin>>primitiveDeflateBlock (in category 'primitives') -----
  primitiveDeflateBlock
  	"Primitive. Deflate the current contents of the receiver."
  	| goodMatch chainLength lastIndex rcvr result |
  	<export: true>
  	<inline: false>
  	interpreterProxy methodArgumentCount = 3
  		ifFalse:[^interpreterProxy primitiveFail].
  	goodMatch := interpreterProxy stackIntegerValue: 0.
  	chainLength := interpreterProxy stackIntegerValue: 1.
  	lastIndex := interpreterProxy stackIntegerValue: 2.
  	rcvr := interpreterProxy stackObjectValue: 3.
  	interpreterProxy failed ifTrue:[^nil].
  	self cCode:'' inSmalltalk:[
  		zipMatchLengthCodes := CArrayAccessor on: ZipWriteStream matchLengthCodes.
  		zipDistanceCodes := CArrayAccessor on: ZipWriteStream distanceCodes].
  	(self loadDeflateStreamFrom: rcvr)
  		ifFalse:[^interpreterProxy primitiveFail].
  	result := self deflateBlock: lastIndex chainLength: chainLength goodMatch: goodMatch.
  	interpreterProxy failed ifFalse:[
  		"Store back modified values"
+ 		interpreterProxy storeInteger: writeStreamInstSize + 2 ofObject: rcvr withValue: zipHashValue.
+ 		interpreterProxy storeInteger: writeStreamInstSize + 3 ofObject: rcvr withValue: zipBlockPos.
+ 		interpreterProxy storeInteger: writeStreamInstSize + 9 ofObject: rcvr withValue: zipLiteralCount.
+ 		interpreterProxy storeInteger: writeStreamInstSize + 10 ofObject: rcvr withValue: zipMatchCount].
- 		interpreterProxy storeInteger: 6 ofObject: rcvr withValue: zipHashValue.
- 		interpreterProxy storeInteger: 7 ofObject: rcvr withValue: zipBlockPos.
- 		interpreterProxy storeInteger: 13 ofObject: rcvr withValue: zipLiteralCount.
- 		interpreterProxy storeInteger: 14 ofObject: rcvr withValue: zipMatchCount].
  	interpreterProxy failed ifFalse:[
  		interpreterProxy pop: 4.
  		interpreterProxy pushBool: result.
  	].!

Item was changed:
  ----- Method: DeflatePlugin>>primitiveUpdateAdler32 (in category 'primitives') -----
  primitiveUpdateAdler32
  	"Primitive. Update a 32bit CRC value."
  	| collection stopIndex startIndex length bytePtr s1 adler32 s2 b |
  	<export: true>
  	<var: #adler32 type:'unsigned int '>
  	<var: #bytePtr type:'unsigned char *'>
  	interpreterProxy methodArgumentCount = 4
  		ifFalse:[^interpreterProxy primitiveFail].
  	collection := interpreterProxy stackObjectValue: 0.
  	stopIndex := interpreterProxy stackIntegerValue: 1.
  	startIndex := interpreterProxy stackIntegerValue: 2.
  	adler32 := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 3).
  	interpreterProxy failed ifTrue:[^0].
  	((interpreterProxy isBytes: collection) and:[stopIndex >= startIndex and:[startIndex > 0]])
  		ifFalse:[^interpreterProxy primitiveFail].
  	length := interpreterProxy byteSizeOf: collection.
  	(stopIndex <= length) ifFalse:[^interpreterProxy primitiveFail].
  	bytePtr := interpreterProxy firstIndexableField: collection.
  	startIndex := startIndex - 1.
  	stopIndex := stopIndex - 1.
  	s1 := adler32 bitAnd: 16rFFFF.
  	s2 := (adler32 >> 16) bitAnd: 16rFFFF.
  	startIndex to: stopIndex do:[:i|
  		b := bytePtr at: i.
  		s1 := (s1 + b) \\ 65521.
  		s2 := (s2 + s1) \\ 65521.
  	].
  	adler32 := (s2 bitShift: 16) + s1.
+ 	interpreterProxy
+ 		pop: 5 "args + rcvr"
+ 		thenPush: (interpreterProxy positive32BitIntegerFor: adler32)!
- 	interpreterProxy pop: 5. "args + rcvr"
- 	interpreterProxy push: (interpreterProxy positive32BitIntegerFor: adler32).!

Item was changed:
  ----- Method: DeflatePlugin>>primitiveZipSendBlock (in category 'primitives') -----
  primitiveZipSendBlock
  	| distTree litTree distStream litStream rcvr result |
  	<export: true>
  	interpreterProxy methodArgumentCount = 4 
  		ifFalse:[^interpreterProxy primitiveFail].
  	distTree := interpreterProxy stackObjectValue: 0.
  	litTree := interpreterProxy stackObjectValue: 1.
  	distStream := interpreterProxy stackObjectValue: 2.
  	litStream := interpreterProxy stackObjectValue: 3.
  	rcvr := interpreterProxy stackObjectValue: 4.
  	interpreterProxy failed ifTrue:[^nil].
  	(self loadZipEncoderFrom: rcvr)
  		ifFalse:[^interpreterProxy primitiveFail].
  	((interpreterProxy isPointers: distTree) and:[
  		(interpreterProxy slotSizeOf: distTree) >= 2])
  			ifFalse:[^interpreterProxy primitiveFail].
  	((interpreterProxy isPointers: litTree) and:[
  		(interpreterProxy slotSizeOf: litTree) >= 2])
  			ifFalse:[^interpreterProxy primitiveFail].
  	((interpreterProxy isPointers: litStream) and:[
  		(interpreterProxy slotSizeOf: litStream) >= 3])
  			ifFalse:[^interpreterProxy primitiveFail].
  	((interpreterProxy isPointers: distStream) and:[
  		(interpreterProxy slotSizeOf: distStream) >= 3])
  			ifFalse:[^interpreterProxy primitiveFail].
  	self cCode:'' inSmalltalk:[
  		zipMatchLengthCodes := CArrayAccessor on: ZipWriteStream matchLengthCodes.
  		zipDistanceCodes := CArrayAccessor on: ZipWriteStream distanceCodes.
  		zipExtraLengthBits := CArrayAccessor on: ZipWriteStream extraLengthBits.
  		zipExtraDistanceBits := CArrayAccessor on: ZipWriteStream extraDistanceBits.
  		zipBaseLength := CArrayAccessor on: ZipWriteStream baseLength.
  		zipBaseDistance := CArrayAccessor on: ZipWriteStream baseDistance].
  	result := self sendBlock: litStream with: distStream with: litTree with: distTree.
  	interpreterProxy failed ifFalse:[
  		interpreterProxy storeInteger: 1 ofObject: rcvr withValue: zipPosition.
+ 		interpreterProxy storeInteger: readStreamInstSize + 1 ofObject: rcvr withValue: zipBitBuf.
+ 		interpreterProxy storeInteger: readStreamInstSize + 2 ofObject: rcvr withValue: zipBitPos.
- 		interpreterProxy storeInteger: 4 ofObject: rcvr withValue: zipBitBuf.
- 		interpreterProxy storeInteger: 5 ofObject: rcvr withValue: zipBitPos.
  	].
  	interpreterProxy failed ifFalse:[
  		interpreterProxy pop: 5. "rcvr + args"
  		interpreterProxy pushInteger: result.
  	].!

Item was changed:
  InterpreterPlugin subclass: #InflatePlugin
+ 	instanceVariableNames: 'zipCollection zipReadLimit zipPosition zipState zipBitBuf zipBitPos zipSource zipSourcePos zipSourceLimit zipLitTable zipDistTable zipCollectionSize zipLitTableSize zipDistTableSize readStreamInstSize'
- 	instanceVariableNames: 'zipCollection zipReadLimit zipPosition zipState zipBitBuf zipBitPos zipSource zipSourcePos zipSourceLimit zipLitTable zipDistTable zipCollectionSize zipLitTableSize zipDistTableSize'
  	classVariableNames: 'MaxBits StateNoMoreData'
  	poolDictionaries: ''
  	category: 'VMMaker-Plugins'!
  
  !InflatePlugin commentStamp: '<historical>' prior: 0!
  This plugin implements the one crucial function for efficiently decompressing streams.!

Item was added:
+ ----- Method: InflatePlugin>>determineSizeOfReadStream: (in category 'primitive support') -----
+ determineSizeOfReadStream: rcvr
+ 	"Determine the inst size of the class above DeflateStream by
+ 	 looking for the first class whose inst size is less than 13."
+ 	| class |
+ 	class := interpreterProxy fetchClassOf: rcvr.
+ 	[class ~= interpreterProxy nilObject
+ 	 and: [(interpreterProxy instanceSizeOf: class) >= 13]] whileTrue:
+ 		[class := interpreterProxy superclassOf: class].
+ 	class = interpreterProxy nilObject ifTrue:
+ 		[^false].
+ 	readStreamInstSize := interpreterProxy instanceSizeOf: class.
+ 	^true!

Item was added:
+ ----- Method: InflatePlugin>>initialize (in category 'initialize-release') -----
+ initialize
+ 	readStreamInstSize := 0!

Item was changed:
  ----- Method: InflatePlugin>>primitiveInflateDecompressBlock (in category 'primitives') -----
  primitiveInflateDecompressBlock
  	"Primitive. Inflate a single block."
  	| oop rcvr |
  	<export: true>
  	interpreterProxy methodArgumentCount = 2 ifFalse:
  		[^interpreterProxy primitiveFail].
  	"distance table"
  	oop := interpreterProxy stackValue: 0.
  	(interpreterProxy isWords: oop) ifFalse:
  		[^interpreterProxy primitiveFail].
  	zipDistTable := interpreterProxy firstIndexableField: oop.
  	zipDistTableSize := interpreterProxy slotSizeOf: oop.
  
  	"literal table"
  	oop := interpreterProxy stackValue: 1.
  	(interpreterProxy isWords: oop) ifFalse:
  		[^interpreterProxy primitiveFail].
  	zipLitTable := interpreterProxy firstIndexableField: oop.
  	zipLitTableSize := interpreterProxy slotSizeOf: oop.
  
  
  	"Receiver (InflateStream)"
  	rcvr := interpreterProxy stackValue: 2.
  	(interpreterProxy isPointers: rcvr) ifFalse:
  		[^interpreterProxy primitiveFail].
- 	(interpreterProxy slotSizeOf: rcvr) < 9
- 		ifTrue:[^interpreterProxy primitiveFail].
- 
  	"All the integer instvars"
+ 	readStreamInstSize = 0 ifTrue:
+ 		[(self determineSizeOfReadStream: rcvr) ifFalse:
+ 			[^interpreterProxy primitiveFail].
+ 		 "If the receiver wasn't valid then we derived readStreamInstSize from an invalid source.  discard it."
+ 		 (interpreterProxy slotSizeOf: rcvr) < (readStreamInstSize + 8) ifTrue:
+ 			[readStreamInstSize := 0.
+ 			 ^interpreterProxy primitiveFail]].
+ 	(interpreterProxy slotSizeOf: rcvr) < (readStreamInstSize + 8) ifTrue:
+ 		[^interpreterProxy primitiveFail].
+ 
  	zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr.
+ 	zipState := interpreterProxy fetchInteger: readStreamInstSize + 0 ofObject: rcvr.
+ 	zipBitBuf := interpreterProxy fetchInteger: readStreamInstSize + 1 ofObject: rcvr.
+ 	zipBitPos := interpreterProxy fetchInteger: readStreamInstSize + 2 ofObject: rcvr.
+ 	zipSourcePos := interpreterProxy fetchInteger: readStreamInstSize + 4 ofObject: rcvr.
+ 	zipSourceLimit := interpreterProxy fetchInteger: readStreamInstSize + 5 ofObject: rcvr.
- 	zipState := interpreterProxy fetchInteger: 3 ofObject: rcvr.
- 	zipBitBuf := interpreterProxy fetchInteger: 4 ofObject: rcvr.
- 	zipBitPos := interpreterProxy fetchInteger: 5 ofObject: rcvr.
- 	zipSourcePos := interpreterProxy fetchInteger: 7 ofObject: rcvr.
- 	zipSourceLimit := interpreterProxy fetchInteger: 8 ofObject: rcvr.
  	interpreterProxy failed ifTrue:[^nil].
  	zipReadLimit := zipReadLimit - 1.
  	zipSourcePos := zipSourcePos - 1.
  	zipSourceLimit := zipSourceLimit - 1.
  
  	"collection"
  	oop := interpreterProxy fetchPointer: 0 ofObject: rcvr.
  	(interpreterProxy isBytes: oop) ifFalse:
  		[^interpreterProxy primitiveFail].
  	zipCollection := interpreterProxy firstIndexableField: oop.
  	zipCollectionSize := interpreterProxy byteSizeOf: oop.
  
  	"source"
+ 	oop := interpreterProxy fetchPointer: readStreamInstSize + 3 ofObject: rcvr.
- 	oop := interpreterProxy fetchPointer: 6 ofObject: rcvr.
  	(interpreterProxy isBytes: oop) ifFalse:
  		[^interpreterProxy primitiveFail].
  	zipSource := interpreterProxy firstIndexableField: oop.
  
  	"do the primitive"
  	self zipDecompressBlock.
  	interpreterProxy failed ifFalse: "store modified values back"
  		[interpreterProxy storeInteger: 2 ofObject: rcvr withValue: zipReadLimit + 1.
+ 		interpreterProxy storeInteger: readStreamInstSize + 0 ofObject: rcvr withValue: zipState.
+ 		interpreterProxy storeInteger: readStreamInstSize + 1 ofObject: rcvr withValue: zipBitBuf.
+ 		interpreterProxy storeInteger: readStreamInstSize + 2 ofObject: rcvr withValue: zipBitPos.
+ 		interpreterProxy storeInteger: readStreamInstSize + 4 ofObject: rcvr withValue: zipSourcePos + 1.
- 		interpreterProxy storeInteger: 3 ofObject: rcvr withValue: zipState.
- 		interpreterProxy storeInteger: 4 ofObject: rcvr withValue: zipBitBuf.
- 		interpreterProxy storeInteger: 5 ofObject: rcvr withValue: zipBitPos.
- 		interpreterProxy storeInteger: 7 ofObject: rcvr withValue: zipSourcePos + 1.
  		interpreterProxy pop: 2]!

More information about the Vm-dev mailing list