VM Maker: VMMaker-dtl.348.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
4 messages Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: VMMaker-dtl.348.mcz

commits-2
 
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'!

Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker-dtl.348.mcz

Eliot Miranda-2
 
Morning, David.

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.
  
- 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
Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker-dtl.348.mcz

David T. Lewis
 
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

Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker-dtl.348.mcz

Eliot Miranda-2
 



On Sun, Jul 20, 2014 at 11:38 AM, David T. Lewis <[hidden email]> wrote:

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.

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.


>
>
> > - 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 ;-)

:-)

In nay case have a lovely afternoon!

--
Aloha,
Eliot