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'! |
Morning, David. On Sun, Jul 20, 2014 at 9:04 AM, <[hidden email]> wrote: --
David, the #initialize methods /are/ needed. If one were to simulate this plugin (which vm developers /do/ do; none of the Cog VMs would exist without it) then the #initialize methods are required to initialize those variables to 0, not nil.
- Do not ^self unnecessarily, not required here and code generated changes would be needed. Could you give me the instances? I'm fairly sure I wouldn't have added a ^self if it wasn't needed. Maybe I mad a mistake?
aloha, Eliot
|
On Sun, Jul 20, 2014 at 11:11:35AM -0700, Eliot Miranda wrote: > > Morning, David. Hi Eliot, Just finished mowing the lawn, back to Squeak for a few minutes :) > > On Sun, Jul 20, 2014 at 9:04 AM, <[hidden email]> wrote: > > > > > 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.. > > > > David, the #initialize methods /are/ needed. If one were to simulate this > plugin (which vm developers /do/ do; none of the Cog VMs would exist > without it) then the #initialize methods are required to initialize those > variables to 0, not nil. I think you have probably added some code generation features to do the right thing with an #initialize method on the instance side of a plugin. Whatever those changes are, they are not yet in VMM trunk. > > > > - Do not ^self unnecessarily, not required here and code generated changes > > would be needed. > > > > Could you give me the instances? I'm fairly sure I wouldn't have added a > ^self if it wasn't needed. Maybe I mad a mistake? No you did not make a mistake, it's just a code generation feature in oscog that is not in trunk. In this case, the return value was not checked, so there was no need to change the original code from '^ 0' to '^ self'. That in turn left me with no defensible reason to spend the afternoon on further code merges, rather than going out to mow the lawn ;-) Dave |
On Sun, Jul 20, 2014 at 11:38 AM, David T. Lewis <[hidden email]> wrote: --
See CCodeGenerator>>addMethodFor:selector: for exclusion if #initialize methods. But I can't remember doing this, only fixing global variable analysis given that #initialize methods were removed. This is the kind of thing (more sophisticated Slang) that makes me want to merge Interpreter into the Cog branch. not the other way around.
:-) In nay case have a lovely afternoon! Aloha, Eliot
|
Free forum by Nabble | Edit this page |