[Vm-dev] VM Maker: VMMaker-dtl.348.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Jul 20 16:05:31 UTC 2014
David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.348.mcz
==================== Summary ====================
Name: VMMaker-dtl.348
Author: dtl
Time: 20 July 2014, 11:57:32.241 am
UUID: 869e87ed-0476-48a8-bca8-fe779633f9ae
Ancestors: VMMaker-dtl.347
VMMaker 4.13.6
Merge VMMaker.oscog-eem.826 except:
- Do not add the #initialize methods, not required because variables are declared static, therefore guaranteed to be initialized to 0. Also would require code generator changes for special treatment of instance side #initialize..
- Do not ^self unnecessarily, not required here and code generated changes would be needed.
Name: VMMaker.oscog-eem.826
Author: eem
Time: 18 July 2014, 5:25:22.251 pm
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-dtl.347 ===============
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 changed:
----- Method: DeflatePlugin>>loadDeflateStreamFrom: (in category 'primitive support') -----
loadDeflateStreamFrom: rcvr
| oop |
<inline: false>
+ ((interpreterProxy isPointers: rcvr)
+ and: [(interpreterProxy slotSizeOf: rcvr) >= 15]) ifFalse:
+ [^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]].
- (interpreterProxy isIntegerObject: oop)
- ifTrue:[^false].
- (interpreterProxy isBytes: oop)
- ifFalse:[^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.
+ ((interpreterProxy isWords: oop)
+ and: [(interpreterProxy slotSizeOf: oop) = DeflateHashTableSize]) ifFalse:
+ [^false].
- oop := interpreterProxy fetchPointer: 4 ofObject: rcvr.
- ((interpreterProxy isIntegerObject: oop) or:[
- (interpreterProxy isWords: oop) not]) ifTrue:[^false].
- (interpreterProxy slotSizeOf: oop) = DeflateHashTableSize ifFalse:[^false].
zipHashHead := interpreterProxy firstIndexableField: oop.
+ oop := interpreterProxy fetchPointer: writeStreamInstSize + 1 ofObject: rcvr.
+ ((interpreterProxy isWords: oop)
+ and: [(interpreterProxy slotSizeOf: oop) = DeflateWindowSize]) ifFalse:
+ [^false].
- oop := interpreterProxy fetchPointer: 5 ofObject: rcvr.
- ((interpreterProxy isIntegerObject: oop) or:[
- (interpreterProxy isWords: oop) not]) ifTrue:[^false].
- (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.
+ (interpreterProxy isBytes: oop) ifFalse:
+ [^false].
- 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 isIntegerObject: oop) or:[
- (interpreterProxy isBytes: oop) not]) ifTrue:[^false].
zipLiteralSize := interpreterProxy slotSizeOf: oop.
zipLiterals := interpreterProxy firstIndexableField: oop.
+ oop := interpreterProxy fetchPointer: writeStreamInstSize + 6 ofObject: rcvr.
+ ((interpreterProxy isWords: oop)
+ and: [(interpreterProxy slotSizeOf: oop) >= zipLiteralSize]) ifFalse:
+ [^false].
- oop := interpreterProxy fetchPointer: 10 ofObject: rcvr.
- ((interpreterProxy isIntegerObject: oop) or:[
- (interpreterProxy isWords: oop) not]) ifTrue:[^false].
- (interpreterProxy slotSizeOf: oop) < zipLiteralSize ifTrue:[^false].
zipDistances := interpreterProxy firstIndexableField: oop.
+ oop := interpreterProxy fetchPointer: writeStreamInstSize + 7 ofObject: rcvr.
+ ((interpreterProxy isWords: oop)
+ and: [(interpreterProxy slotSizeOf: oop) = DeflateMaxLiteralCodes]) ifFalse:
+ [^false].
- oop := interpreterProxy fetchPointer: 11 ofObject: rcvr.
- ((interpreterProxy isIntegerObject: oop) or:[
- (interpreterProxy isWords: oop) not]) ifTrue:[^false].
- (interpreterProxy slotSizeOf: oop) = DeflateMaxLiteralCodes ifFalse:[^false].
zipLiteralFreq := interpreterProxy firstIndexableField: oop.
+ oop := interpreterProxy fetchPointer: writeStreamInstSize + 8 ofObject: rcvr.
+ ((interpreterProxy isWords: oop)
+ and: [(interpreterProxy slotSizeOf: oop) = DeflateMaxDistanceCodes]) ifFalse:
+ [^false].
- oop := interpreterProxy fetchPointer: 12 ofObject: rcvr.
- ((interpreterProxy isIntegerObject: oop) or:[
- (interpreterProxy isWords: oop) not]) ifTrue:[^false].
- (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:
+ [^false].
- ((interpreterProxy isPointers: rcvr) and:[
- (interpreterProxy slotSizeOf: rcvr) >= 6]) ifFalse:[^false].
oop := interpreterProxy fetchPointer: 0 ofObject: rcvr.
+ (interpreterProxy isBytes: oop) ifFalse:
+ [^interpreterProxy primitiveFail].
- (interpreterProxy isIntegerObject: oop)
- ifTrue:[^interpreterProxy primitiveFail].
- (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>>primitiveUpdateGZipCrc32 (in category 'primitives') -----
primitiveUpdateGZipCrc32
"Primitive. Update a 32bit CRC value."
| collection stopIndex startIndex crc length bytePtr |
<export: true>
+ <var: #bytePtr type: #'unsigned char *'>
- <var: #crc type:'unsigned int '>
- <var: #bytePtr type:'unsigned char *'>
- <var: #crcTable type:'unsigned int *'>
interpreterProxy methodArgumentCount = 4
ifFalse:[^interpreterProxy primitiveFail].
collection := interpreterProxy stackObjectValue: 0.
stopIndex := interpreterProxy stackIntegerValue: 1.
startIndex := interpreterProxy stackIntegerValue: 2.
crc := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 3).
+ interpreterProxy failed ifTrue: [^0].
- 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.
self cCode:'' inSmalltalk:[zipCrcTable := CArrayAccessor on: GZipWriteStream crcTable].
startIndex := startIndex - 1.
stopIndex := stopIndex - 1.
+ startIndex to: stopIndex do:
+ [:i|
+ crc := (zipCrcTable at: ((crc bitXor: (bytePtr at: i)) bitAnd: 255)) bitXor: (crc >> 8)].
+ interpreterProxy
+ pop: 5 "args + rcvr"
+ thenPush: (interpreterProxy positive32BitIntegerFor: crc)!
- startIndex to: stopIndex do:[:i|
- crc := (zipCrcTable at: ((crc bitXor: (bytePtr at: i)) bitAnd: 255)) bitXor: (crc >> 8).
- ].
- interpreterProxy pop: 5. "args + rcvr"
- interpreterProxy push: (interpreterProxy positive32BitIntegerFor: crc).!
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:
----- Method: DeflatePlugin>>sendBlock:with:with:with: (in category 'encoding') -----
sendBlock: literalStream with: distanceStream with: litTree with: distTree
"Require:
zipCollection, zipCollectionSize, zipPosition,
zipBitBuf, zipBitPos.
"
| oop litPos litLimit litArray distArray lit dist sum llBitLengths llCodes distBitLengths distCodes code extra litBlCount distBlCount |
+ <var: #litArray type: #'unsigned char *'>
+ <var: #distArray type: #'unsigned int *'>
+ <var: #llBitLengths type: #'unsigned int *'>
+ <var: #llCodes type: #'unsigned int *'>
+ <var: #distBitLengths type: #'unsigned int *'>
+ <var: #distCodes type: #'unsigned int *'>
- <var: #litArray type:'unsigned char *'>
- <var: #distArray type:'unsigned int *'>
- <var: #llBitLengths type:'unsigned int *'>
- <var: #llCodes type:'unsigned int *'>
- <var: #distBitLengths type:'unsigned int *'>
- <var: #distCodes type:'unsigned int *'>
oop := interpreterProxy fetchPointer: 0 ofObject: literalStream.
litPos := interpreterProxy fetchInteger: 1 ofObject: literalStream.
litLimit := interpreterProxy fetchInteger: 2 ofObject: literalStream.
+ (litPos <= litLimit
+ and: [(interpreterProxy isBytes: oop)
+ and: [litLimit <= (interpreterProxy byteSizeOf: oop)]]) ifFalse:
+ [^interpreterProxy primitiveFail].
- ((interpreterProxy isIntegerObject: oop) not and:[litPos <= litLimit and:[
- litLimit <= (interpreterProxy byteSizeOf: oop) and:[interpreterProxy isBytes: oop]]])
- ifFalse:[^interpreterProxy primitiveFail].
litArray := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 0 ofObject: distanceStream.
+ ((interpreterProxy isWords: oop)
+ and: [litLimit <= (interpreterProxy slotSizeOf: oop)
+ and: [(interpreterProxy fetchInteger: 1 ofObject: distanceStream) = litPos
+ and: [(interpreterProxy fetchInteger: 2 ofObject: distanceStream) = litLimit]]]) ifFalse:
+ [^interpreterProxy primitiveFail].
- ((interpreterProxy isIntegerObject: oop) not and:[
- (interpreterProxy fetchInteger: 1 ofObject: distanceStream) = litPos and:[
- (interpreterProxy fetchInteger: 2 ofObject: distanceStream) = litLimit]])
- ifFalse:[^interpreterProxy primitiveFail].
- ((interpreterProxy isWords: oop) and:[
- litLimit <= (interpreterProxy slotSizeOf: oop)])
- ifFalse:[^interpreterProxy primitiveFail].
distArray := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 0 ofObject: litTree.
+ (interpreterProxy isWords: oop) ifFalse:
+ [^interpreterProxy primitiveFail].
- ((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy isWords: oop])
- ifFalse:[^interpreterProxy primitiveFail].
litBlCount := interpreterProxy slotSizeOf: oop.
llBitLengths := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 1 ofObject: litTree.
+ ((interpreterProxy isWords: oop)
+ and: [litBlCount = (interpreterProxy slotSizeOf: oop)]) ifFalse:
+ [^interpreterProxy primitiveFail].
- ((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy isWords: oop])
- ifFalse:[^interpreterProxy primitiveFail].
- (litBlCount = (interpreterProxy slotSizeOf: oop))
- ifFalse:[^interpreterProxy primitiveFail].
llCodes := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 0 ofObject: distTree.
+ (interpreterProxy isWords: oop) ifFalse:
+ [^interpreterProxy primitiveFail].
- ((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy isWords: oop])
- ifFalse:[^interpreterProxy primitiveFail].
distBlCount := interpreterProxy slotSizeOf: oop.
distBitLengths := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 1 ofObject: distTree.
+ ((interpreterProxy isWords: oop)
+ and: [distBlCount = (interpreterProxy slotSizeOf: oop)]) ifFalse:
+ [^interpreterProxy primitiveFail].
- ((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy isWords: oop])
- ifFalse:[^interpreterProxy primitiveFail].
- (distBlCount = (interpreterProxy slotSizeOf: oop))
- ifFalse:[^interpreterProxy primitiveFail].
distCodes := interpreterProxy firstIndexableField: oop.
- interpreterProxy failed ifTrue:[^nil].
-
self nextZipBits: 0 put: 0. "Flush pending bits if necessary"
sum := 0.
[litPos < litLimit and:[zipPosition + 4 < zipCollectionSize]] whileTrue:[
lit := litArray at: litPos.
dist := distArray at: litPos.
litPos := litPos + 1.
dist = 0 ifTrue:["literal"
sum := sum + 1.
lit < litBlCount ifFalse:[^interpreterProxy primitiveFail].
self nextZipBits: (llBitLengths at: lit) put: (llCodes at: lit).
] ifFalse:["match"
sum := sum + lit + DeflateMinMatch.
lit < 256 ifFalse:[^interpreterProxy primitiveFail].
code := zipMatchLengthCodes at: lit.
code < litBlCount ifFalse:[^interpreterProxy primitiveFail].
self nextZipBits: (llBitLengths at: code) put: (llCodes at: code).
extra := zipExtraLengthBits at: code - 257.
extra = 0 ifFalse:[
lit := lit - (zipBaseLength at: code - 257).
self nextZipBits: extra put: lit].
dist := dist - 1.
dist < 16r8000 ifFalse:[^interpreterProxy primitiveFail].
dist < 256
ifTrue:[code := zipDistanceCodes at: dist]
ifFalse:[code := zipDistanceCodes at: 256 + (dist >> 7)].
code < distBlCount ifFalse:[^interpreterProxy primitiveFail].
self nextZipBits: (distBitLengths at: code) put: (distCodes at: code).
extra := zipExtraDistanceBits at: code.
extra = 0 ifFalse:[
dist := dist - (zipBaseDistance at: code).
self nextZipBits: extra put: dist].
].
].
interpreterProxy failed ifTrue:[^nil].
interpreterProxy storeInteger: 1 ofObject: literalStream withValue: litPos.
interpreterProxy storeInteger: 1 ofObject: distanceStream withValue: litPos.
^sum!
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 class>>simulatorClass (in category 'simulation') -----
+ simulatorClass
+ "For running from Smalltalk - answer a class that can be used to simulate the receiver,
+ or nil if you want the primitives in this module to always fail, causing simulation to fall
+ through to the Smalltalk code. By default every non-TestInterpreterPlugin can simulate itself."
+
+ ^DeflatePlugin!
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 changed:
----- Method: InflatePlugin>>primitiveInflateDecompressBlock (in category 'primitives') -----
primitiveInflateDecompressBlock
"Primitive. Inflate a single block."
| oop rcvr |
<export: true>
+ interpreterProxy methodArgumentCount = 2 ifFalse:
+ [^interpreterProxy primitiveFail].
- interpreterProxy methodArgumentCount = 2 ifFalse:[^interpreterProxy primitiveFail].
"distance table"
+ oop := interpreterProxy stackValue: 0.
+ (interpreterProxy isWords: oop) ifFalse:
+ [^interpreterProxy primitiveFail].
- oop := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
- (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].
- oop := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (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].
- rcvr := interpreterProxy stackObjectValue: 2.
- interpreterProxy failed ifTrue:[^nil].
- (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].
- (interpreterProxy isIntegerObject: oop)
- ifTrue:[^interpreterProxy primitiveFail].
- (interpreterProxy isBytes: oop)
- ifFalse:[^interpreterProxy primitiveFail].
zipCollection := interpreterProxy firstIndexableField: oop.
zipCollectionSize := interpreterProxy byteSizeOf: oop.
"source"
+ oop := interpreterProxy fetchPointer: readStreamInstSize + 3 ofObject: rcvr.
+ (interpreterProxy isBytes: oop) ifFalse:
+ [^interpreterProxy primitiveFail].
- oop := interpreterProxy fetchPointer: 6 ofObject: rcvr.
- (interpreterProxy isIntegerObject: oop)
- ifTrue:[^interpreterProxy primitiveFail].
- (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 pop: 2]!
- interpreterProxy failed ifFalse:[
- "store modified values back"
- interpreterProxy storeInteger: 2 ofObject: rcvr withValue: zipReadLimit + 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.
- ].!
Item was changed:
----- Method: VMMaker class>>versionString (in category 'version testing') -----
versionString
"VMMaker versionString"
+ ^'4.13.6'!
- ^'4.13.5'!
More information about the Vm-dev
mailing list