VM Maker: Cog-eem.90.mcz

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

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

Name: Cog-eem.90
Author: eem
Time: 18 September 2013, 2:01:05.377 pm
UUID: e329ae21-983a-4410-87ad-9559f7fc3cda
Ancestors: Cog-eem.89

Make class table pages strong.

Avoid sending size to Symbol.

=============== Diff against Cog-eem.89 ===============

Item was changed:
  ----- Method: SpurBootstrap>>allocateClassTable (in category 'bootstrap image') -----
  allocateClassTable
  "Allocate the root of the classTable plus enough pages to accomodate all classes in
  the classToIndex map.  Don't fill in the entries yet; the classes have yet to be cloned."
  | tableRootSize tableRoot page maxSize numPages |
  tableRootSize := self classTableSize / newHeap classTablePageSize.
  tableRoot := newHeap
  allocateSlots: tableRootSize
  format: newHeap arrayFormat
  classIndex: newHeap arrayClassIndexPun.
  self assert: (newHeap numSlotsOf: tableRoot) = tableRootSize.
  self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat.
  self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun.
  newHeap nilFieldsOf: tableRoot.
  "first page is strong"
  page := newHeap
  allocateSlots: newHeap classTablePageSize
  format: newHeap arrayFormat
  classIndex: newHeap arrayClassIndexPun.
  self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize.
  self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat.
  self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun.
  self assert: (newHeap objectAfter: tableRoot limit: newHeap freeStart) = page.
  lastClassTablePage := page.
  newHeap nilFieldsOf: page.
  newHeap storePointer: 0 ofObject: tableRoot withValue: page.
  newHeap classTableRootObj: tableRoot.
  maxSize := classToIndex inject: 0 into: [:a :b| a max: b].
  numPages := (maxSize + newHeap classTableMinorIndexMask / newHeap classTablePageSize) truncated.
  2 to: numPages do:
  [:i|
  page := newHeap
  allocateSlots: newHeap classTablePageSize
+ format: newHeap arrayFormat
+ classIndex: newHeap arrayClassIndexPun.
- format: newHeap weakArrayFormat
- classIndex: newHeap weakArrayClassIndexPun.
  self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize.
+ self assert: (newHeap formatOf: page) = newHeap arrayFormat.
+ self assert: (newHeap classIndexOf: page) = newHeap arrayClassIndexPun.
+ newHeap fillObj: page numSlots: newHeap classTablePageSize with: newHeap nilObject.
- self assert: (newHeap formatOf: page) = newHeap weakArrayFormat.
- self assert: (newHeap classIndexOf: page) = newHeap weakArrayClassIndexPun.
- newHeap nilFieldsOf: page.
  newHeap storePointer: i - 1 ofObject: tableRoot withValue: page.
  self assert: (newHeap objectAfter: (newHeap fetchPointer: i - 2 ofObject: tableRoot)  limit: newHeap freeStart) = page.
  lastClassTablePage := page]!

Item was changed:
  ----- Method: SpurBootstrap>>fillInClassTable (in category 'bootstrap image') -----
  fillInClassTable
+ | firstPage maxIndex |
- | firstPage classWeakArray maxIndex |
  maxIndex := 0.
  classToIndex keysAndValuesDo:
  [:oldClass :index| | newClass page |
  maxIndex := maxIndex max: index.
  newClass := map at: oldClass.
  self assert: (newHeap isPointersNonImm: newClass).
  newHeap setHashBitsOf: newClass to: index.
  page := newHeap
  fetchPointer: index >> newHeap classTableMajorIndexShift
  ofObject: newHeap classTableRootObj.
  newHeap
  storePointer: (index bitAnd: newHeap classTableMinorIndexMask)
  ofObject: page
  withValue: newClass.
  self assert: (newHeap classAtIndex: index) = newClass].
  firstPage := newHeap
  fetchPointer: 0
  ofObject: newHeap classTableRootObj.
- classWeakArray := classToIndex keys detect:
- [:oldClass|
- (oldHeap instSpecOfClass: oldClass) = 4
- and: [oldInterpreter classNameOf: oldClass Is: 'WeakArray']].
  newHeap
  storePointer: 1
  ofObject: firstPage
  withValue: (map at: oldHeap classSmallInteger);
  storePointer: 2
  ofObject: firstPage
  withValue: (map at: oldHeap classCharacter);
  storePointer: 3
  ofObject: firstPage
  withValue: (map at: oldHeap classSmallInteger);
  storePointer: newHeap arrayClassIndexPun
  ofObject: firstPage
  withValue: (map at: oldHeap classArray);
+ storePointer: newHeap arrayClassIndexPun
- storePointer: newHeap weakArrayClassIndexPun
  ofObject: firstPage
+ withValue: (map at: oldHeap classArray).
- withValue: (map at: classWeakArray).
 
  newHeap classTableIndex: maxIndex!

Item was changed:
  ----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') -----
  rehashImage
  "Rehash all collections in newHeap.
  Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags.
  Enumerate all objects, rehashing those whose class has a bit set in rehashFlags."
  | n sim rehashFlags |
  sim := StackInterpreterSimulator onObjectMemory: newHeap.
  newHeap coInterpreter: sim.
  sim initializeInterpreter: 0.
  sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal.
 
  newHeap
  setHashBitsOf: newHeap nilObject to: 1;
  setHashBitsOf: newHeap falseObject to: 2;
  setHashBitsOf: newHeap trueObject to: 3.
 
  rehashFlags := ByteArray new: newHeap classTableIndex + 7 // 8.
  n := 0.
  newHeap classTableObjectsDo:
  [:class| | classIndex |
  sim messageSelector: (map at: rehashSym).
  "Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self."
  ((sim lookupMethodNoMNUEtcInClass: class) = 0
  and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue:
  [n := n + 1.
  classIndex := newHeap rawHashBitsOf: class.
  rehashFlags
  at: classIndex >> 3 + 1
  put: ((rehashFlags at: classIndex >> 3 + 1)
  bitOr: (1 << (classIndex bitAnd: 7)))]].
  Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush.
  n := 0.
  self withExecutableInterpreter: sim
+ do: [sim setBreakSelector: 'error:'.
+ "don't rehash twice (actually without limit), so don't rehash any new objects created."
+ newHeap allExistingOldSpaceObjectsDo:
- do: "don't rehash twice (actually without limit), so don't rehash any new objects created."
- [newHeap allExistingObjectsDo:
  [:o| | classIndex |
  classIndex := newHeap classIndexOf: o.
  ((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue:
  [(n := n + 1) \\ 8 = 0 ifTrue:
  [Transcript nextPut: $.; flush].
  "2845 = n ifTrue: [self halt]."
+ "Rehash an object if its size is > 0.
+  Symbol implements rehash, but doesn't understand size, so don't send size to classes.
+  Don't rehash empty collections; they may be large for a reason and rehashing will shrink them."
+ ((sim addressCouldBeClassObj: o)
+   or: [(self interpreter: sim
- (self interpreter: sim
  object: o
  perform: (map at: sizeSym)
+ withArguments: #()) ~= (newHeap integerObjectOf: 0)]) ifTrue:
- withArguments: #()) ~= (newHeap integerObjectOf: 0) ifTrue:
  [self interpreter: sim
  object: o
  perform: (map at: rehashSym)
  withArguments: #()]]]]!

Item was changed:
  ----- Method: SpurBootstrap>>replacementForCharacterMethod: (in category 'bootstrap methods') -----
  replacementForCharacterMethod: characterMethodOop
  "Answer a replacement method for the argument if it refers
  to Character's old inst var value.  Otherwise answer nil."
  | proxy asIntegerProxy clone assembly newInsts newMethod |
+ "(oldHeap stringOf: (oldHeap longAt: characterMethodOop + (oldHeap lastPointerOf: characterMethodOop) - 4)) = 'isOctetCharacter' ifTrue:
+ [self halt]."
- (oldHeap stringOf: (oldHeap longAt: characterMethodOop + (oldHeap lastPointerOf: characterMethodOop) - 4)) = 'isOctetCharacter' ifTrue:
- [self halt].
  proxy := VMCompiledMethodProxy new
  for: characterMethodOop
  coInterpreter: oldInterpreter
  objectMemory: oldHeap.
  clone := self cloneMethodProxy: proxy.
  clone hasInstVarRef ifFalse:
  [^nil].
  clone setSourcePointer: 0.
  asIntegerProxy := VMObjectProxy new
  for: (symbolMap at: #asInteger)
  coInterpreter: oldInterpreter
  objectMemory: oldHeap.
  assembly := BytecodeDisassembler new disassemble: clone.
  assembly literals: (assembly literals allButLast: 2), {asIntegerProxy}, (assembly literals last: 2).
  "Do this by looking for index of pushReceiverVariable: and replacing it by pushSelf, send asInteger"
  newInsts := (assembly instructions piecesCutWhere:
  [:msgOrLabelAssoc :nextInst|
  msgOrLabelAssoc isVariableBinding not
  and: [msgOrLabelAssoc selector == #pushReceiverVariable:]]) fold:
  [:a :b|
  a allButLast,
  { Message selector: #pushReceiver.
  Message
  selector: #send:super:numArgs:
  arguments: {asIntegerProxy. false. 0}},
  b].
  assembly instructions: newInsts.
  newMethod := assembly assemble.
  ^self
  installableMethodFor: newMethod
  selector: clone selector
  className: #Character
  isMeta: false!