VM Maker: VMMaker.oscog-eem.389.mcz

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

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

Name: VMMaker.oscog-eem.389
Author: eem
Time: 17 September 2013, 6:07:49.233 pm
UUID: f512174f-1d31-4863-8ace-a710b4ae527a
Ancestors: VMMaker.oscog-eem.388

Merge fix for http://bugs.squeak.org/view.php?id=7247 in
VMMaker-tpr.325.

Make objCouldBeClassObj: accespt classes not yet in classTable
(they may contain forwarding pointers).

Comment typo.

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

Item was changed:
  ----- Method: BitBltSimulation>>alphaSourceBlendBits8 (in category 'inner loop') -----
  alphaSourceBlendBits8
  "This version assumes
  combinationRule = 34
  sourcePixSize = 32
  destPixSize = 8
  sourceForm ~= destForm.
  Note: This is not real blending since we don't have the source colors available.
  "
  | srcIndex dstIndex sourceWord srcAlpha destWord deltaX deltaY
  srcY dstY dstMask srcShift adjust mappingTable mapperFlags |
  <inline: false>
  <var: #mappingTable type:'unsigned int *'>
  mappingTable := self default8To32Table.
  mapperFlags := cmFlags bitAnd: ColorMapNewStyle bitInvert32.
  deltaY := bbH + 1. "So we can pre-decrement"
  srcY := sy.
  dstY := dy.
  mask1 := ((dx bitAnd: 3) * 8).
  destMSB ifTrue:[mask1 := 24 - mask1].
  mask2 := AllOnes bitXor:(16rFF << mask1).
  (dx bitAnd: 1) = 0
  ifTrue:[adjust := 0]
  ifFalse:[adjust := 16r1F1F1F1F].
  (dy bitAnd: 1) = 0
  ifTrue:[adjust := adjust bitXor: 16r1F1F1F1F].
  "This is the outer loop"
  [(deltaY := deltaY - 1) ~= 0] whileTrue:[
  adjust := adjust bitXor: 16r1F1F1F1F.
  srcIndex := sourceBits + (srcY * sourcePitch) + (sx * 4).
  dstIndex := destBits + (dstY * destPitch) + (dx // 4 * 4).
  deltaX := bbW + 1. "So we can pre-decrement"
  srcShift := mask1.
  dstMask := mask2.
 
  "This is the inner loop"
  [(deltaX := deltaX - 1) ~= 0] whileTrue:[
  sourceWord := ((self srcLongAt: srcIndex) bitAnd: (adjust bitInvert32)) + adjust.
  srcAlpha := sourceWord >> 24.
  srcAlpha > 31 ifTrue:["Everything below 31 is transparent"
  srcAlpha < 224 ifTrue:["Everything above 224 is opaque"
  destWord := self dstLongAt: dstIndex.
  destWord := destWord bitAnd: dstMask bitInvert32.
  destWord := destWord >> srcShift.
  destWord := mappingTable at: destWord.
  sourceWord := self alphaBlendScaled: sourceWord with: destWord.
  ].
  sourceWord := self mapPixel: sourceWord flags: mapperFlags.
  sourceWord := sourceWord << srcShift.
  "Store back"
  self dstLongAt: dstIndex put: sourceWord mask: dstMask.
  ].
  srcIndex := srcIndex + 4.
  destMSB ifTrue:[
  srcShift = 0
  ifTrue:[dstIndex := dstIndex + 4.
  srcShift := 24.
  dstMask := 16r00FFFFFF]
  ifFalse:[srcShift := srcShift - 8.
  dstMask := (dstMask >> 8) bitOr: 16rFF000000].
  ] ifFalse:[
+ srcShift = 24
- srcShift = 32
  ifTrue:[dstIndex := dstIndex + 4.
  srcShift := 0.
  dstMask := 16rFFFFFF00]
  ifFalse:[srcShift := srcShift + 8.
  dstMask := dstMask << 8 bitOr: 255].
  ].
  adjust := adjust bitXor: 16r1F1F1F1F.
  ].
  srcY := srcY + 1.
  dstY := dstY + 1.
  ].!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') -----
  allocateOldSpaceChunkOfBytes: chunkBytes
  "Answer a chunk of oldSpace from the free lists, if available,
  otherwise answer nil.  N.B.  the chunk is simply a pointer, it has
+ no valid header.  The caller *must* fill in the header correctly."
- no valid header.  The caler *must* fill in the header correctly."
  | index chunk nextIndex nodeBytes parent child smaller larger |
  index := chunkBytes / self allocationUnit.
  index < NumFreeLists ifTrue:
  [(chunk := freeLists at: index) ~= 0 ifTrue:
  [^self unlinkFreeChunk: chunk atIndex: index].
  "first search for free chunks of a multiple of chunkBytes in size"
  nextIndex := index.
  [(nextIndex := nextIndex + index) < NumFreeLists] whileTrue:
  [(chunk := freeLists at: index) ~= 0 ifTrue:
  [self unlinkFreeChunk: chunk atIndex: index.
  self assert: (self bytesInObject: chunk) = index * self allocationUnit.
  self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  at: (self startOfFreeChunk: chunk) + chunkBytes.
  ^chunk]].
  "now get desperate and use the first that'll fit"
  nextIndex := index.
  [(nextIndex := nextIndex + 1) < NumFreeLists] whileTrue:
  [(chunk := freeLists at: index) ~= 0 ifTrue:
  [self unlinkFreeChunk: chunk atIndex: index.
  self assert: (self bytesInObject: chunk) = index * self allocationUnit.
  self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  at: (self startOfFreeChunk: chunk) + chunkBytes.
  ^chunk]]].
 
  "Large chunk, or no space on small free lists.  Search the large chunk list.
  Large chunk list organized as a tree, each node of which is a list of chunks
  of the same size. Beneath the node are smaller and larger blocks."
  parent := 0.
  child := freeLists at: 0.
  [child ~= 0] whileTrue:
  [nodeBytes := self bytesInObject: child.
  parent := child.
  nodeBytes = chunkBytes
  ifTrue: "size match; try to remove from list at node."
  [chunk := self fetchPointer: self freeChunkNextIndex
  ofForwardedOrFreeObject: child.
  chunk ~= 0 ifTrue:
  [self storePointer: self freeChunkNextIndex
  ofForwardedOrFreeObject: child
  withValue: (self fetchPointer: self freeChunkNextIndex
  ofForwardedOrFreeObject: chunk).
  ^chunk].
  child := 0] "break out of loop to remove interior node"
  ifFalse:"walk down the tree"
  [child := self fetchPointer: (nodeBytes > chunkBytes
  ifTrue: [self freeChunkSmallerIndex]
  ifFalse: [self freeChunkLargerIndex])
  ofObject: child]].
  parent = 0 ifTrue:
  [self halt].
  "self printFreeChunk: parent"
  self assert: (self bytesInObject: parent) = nodeBytes.
  "attempt to remove from list"
  chunk := self fetchPointer: self freeChunkNextIndex
  ofForwardedOrFreeObject: parent.
  chunk ~= 0 ifTrue:
  [self storePointer: self freeChunkNextIndex
  ofForwardedOrFreeObject: parent
  withValue: (self fetchPointer: self freeChunkNextIndex
  ofForwardedOrFreeObject: chunk).
  chunkBytes ~= nodeBytes ifTrue:
  [self freeChunkWithBytes: nodeBytes - chunkBytes
  at: (self startOfFreeChunk: chunk) + chunkBytes].
  ^chunk].
  "no list; remove an interior node"
  chunk := parent.
  parent := self fetchPointer: self freeChunkParentIndex ofForwardedOrFreeObject: chunk.
  "no parent; stitch the subnodes back into the root"
  parent = 0 ifTrue:
  [smaller := self fetchPointer: self freeChunkSmallerIndex ofForwardedOrFreeObject: chunk.
  larger := self fetchPointer: self freeChunkLargerIndex ofForwardedOrFreeObject: chunk.
  smaller = 0
  ifTrue: [freeLists at: 0 put: larger]
  ifFalse:
  [freeLists at: 0 put: smaller.
  larger ~= 0 ifTrue:
  [self addFreeSubTree: larger]].
  chunkBytes ~= nodeBytes ifTrue:
  [self freeChunkWithBytes: nodeBytes - chunkBytes
  at: (self startOfFreeChunk: chunk) + chunkBytes].
  ^chunk].
  "remove node from tree; reorder tree simply.  two cases (which have mirrors, for four total):
  case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
  ___  ___
  | P |  | P |
     _/_ _/_
     | N | => | S |
  _/_
  | S |"
  self halt.
  "case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
  add the left subtree to the bottom left of the right subtree (mirrored for large vs small)
  ___  ___
  | P |  | P |
     _/_ _/_
     | N | => | R |
  _/_  _\_    _/_
  | L | | R |    | L |"
  self halt!

Item was changed:
  ----- Method: StackInterpreter>>objCouldBeClassObj: (in category 'debug support') -----
  objCouldBeClassObj: objOop
+ "Answer if objOop looks like a class object.  WIth Spur be lenient if the object doesn't
+ yet have a hash (i.e. is not yet in the classTable), and accept forwarding pointers."
- "Answer if objOop looks like a class object"
  <inline: false>
+ | field |
  ^(objectMemory isPointersNonImm: objOop)
   and: [(objectMemory numSlotsOf: objOop) >= (InstanceSpecificationIndex+1)
+  and: [field := objectMemory fetchPointer: SuperclassIndex ofObject: objOop.
+ ((objectMemory isPointers: field)
+ or: [(objectMemory rawHashBitsOf: objOop) = 0
+ and: [(objectMemory isOopForwarded: field)
+ and: [objectMemory isPointers: (objectMemory followForwarded: field)]]])
+  and: [field := objectMemory fetchPointer: MethodDictionaryIndex ofObject: objOop.
+ ((objectMemory isPointers: field)
+ or: [(objectMemory rawHashBitsOf: objOop) = 0
+ and: [(objectMemory isOopForwarded: field)
+ and: [objectMemory isPointers: (objectMemory followForwarded: field)]]])
-  and: [(objectMemory isPointers: (objectMemory fetchPointer: SuperclassIndex ofObject: objOop))
-  and: [(objectMemory isPointers: (objectMemory fetchPointer: MethodDictionaryIndex ofObject: objOop))
   and: [(objectMemory isIntegerObject: (objectMemory fetchPointer: InstanceSpecificationIndex ofObject: objOop))]]]]!