VM Maker: VMMaker.oscog-cb.2390.mcz

 
ClementBera uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2390.mcz

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

Name: VMMaker.oscog-cb.2390
Author: cb
Time: 29 May 2018, 4:10:06.474615 pm
UUID: 24984602-b70a-4b9c-af24-2ff42f844c26
Ancestors: VMMaker.oscog-cb.2389

Fixed consistency checks in VMClass to succeed if no compactorClass is present.

Fixed simulation of segments to re-use correctly memory. It used to be badly broken (sometimes the simulator would think there is enough room for segment + delta, but there wasn't; other segments would just overlap each other entirely).

Added segmentOverlap assertions and debugging convenience.

Finally I have the same bug in the simulator than in the real C VM! I can debug my compactor again.

=============== Diff against VMMaker.oscog-cb.2389 ===============

Item was changed:
  ----- Method: SpurMemoryManager>>sqAllocateMemorySegmentOfSize:Above:AllocatedSizeInto: (in category 'simulation only') -----
  sqAllocateMemorySegmentOfSize: segmentSize Above: minAddress AllocatedSizeInto: allocSizePtrOrBlock
  <doNotGenerate>
  "Simulate heap growth by growing memory by segmentSize + a delta.
  To test bridges alternate the delta between 0 bytes and 1M bytes
  depending on the number of segments.
  The delta will be the distance between segments to be bridged."
  | delta newMemory start |
  self assert: segmentSize \\ memory bytesPerElement = 0.
  delta := segmentManager numSegments odd ifTrue: [1024 * 1024] ifFalse: [0].
+ "A previous shrink may have freed up memory.  Don't bother to grow if there's already room.
+ At minAddress there is a hole of segmentSize or it is the segLimit of the last segment.
+ However there is no hole of segmentSize + delta guaranteed..."
+ 0 to: segmentManager numSegments - 1 do:
+ [:i| | segment bridge |
+ segment := segmentManager segments at: i.
+ bridge := segmentManager bridgeAt: i.
+ (segment segLimit >= minAddress
+ and: [(self bytesInObject: bridge) - self bridgeSize >= (segmentSize + delta)]) ifTrue: [
+ allocSizePtrOrBlock value: segmentSize.
+ ^ segment segLimit + delta] ].
- "A previous shrink may have freed up memory.  Don't bother to grow if there's already room."
- segmentManager lastSegment segLimit + segmentSize + delta <= (memory size * memory bytesPerElement) ifTrue:
- [allocSizePtrOrBlock value: segmentSize.
- ^minAddress + delta].
  start := memory size * memory bytesPerElement + delta.
  newMemory := memory class new: memory size + (segmentSize + delta / memory bytesPerElement).
  newMemory replaceFrom: 1 to: memory size with: memory startingAt: 1.
  memory := newMemory.
  allocSizePtrOrBlock value: segmentSize.
  ^start!

Item was changed:
  ----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') -----
  addSegmentOfSize: ammount
  <returnTypeC: #'SpurSegmentInfo *'>
  <inline: false>
  | allocatedSize |
  <var: #newSeg type: #'SpurSegmentInfo *'>
  <var: #segAddress type: #'void *'>
  <var: #allocatedSize type: #'usqInt'>
  self cCode: [] inSmalltalk: [segments ifNil: [^nil]]. "bootstrap"
  (manager "sent to the manager so that the simulator can increase memory to simulate a new segment"
  sqAllocateMemorySegmentOfSize: ammount
  Above: (self firstGapOfSizeAtLeast: ammount)
  AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize]
  inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil:
  [:segAddress| | newSegIndex newSeg |
  newSegIndex := self insertSegmentFor: segAddress asUnsignedIntegerPtr.
+ "Simulation insertion code duplicates entries if newSegIndex ~= numSegments - 1"
+ self cCode: '' inSmalltalk: [segments at: newSegIndex put: SpurSegmentInfo new].
  newSeg := self addressOf: (segments at: newSegIndex).
  newSeg
  segStart: segAddress asUnsignedIntegerPtr;
  segSize: allocatedSize.
+ self assert: self segmentOverlap not. "self printSegmentAddresses."
  self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg.
  self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse:
  [self addressOf: (segments at: newSegIndex + 1)]).
  totalHeapSizeIncludingBridges := totalHeapSizeIncludingBridges + allocatedSize.
  "test isInMemory:"
  0 to: numSegments - 1 do:
  [:i|
  self assert: (self isInSegments: (segments at: i) segStart).
  self assert: (self isInSegments: (segments at: i) segLimit - manager wordSize).
  self assert: ((self isInSegments: (segments at: i) segLimit) not
  or: [i < (numSegments - 1)
  and: [(segments at: i) segLimit = (segments at: i + 1) segStart]]).
  self assert: ((self isInSegments: (segments at: i) segStart - manager wordSize) not
  or: [i > 0
  and: [(segments at: i - 1) segLimit = (segments at: i) segStart]])].
  ^newSeg].
  ^nil!

Item was changed:
  ----- Method: SpurSegmentManager>>bridgeFrom:to: (in category 'growing/shrinking memory') -----
  bridgeFrom: aSegment to: nextSegmentOrNil
  "Create a bridge from aSegment to the next segment,
  or create a terminating bridge if there is no next segment."
  <var: #aSegment type: #'SpurSegmentInfo *'>
  <var: #nextSegmentOrNil type: #'SpurSegmentInfo *'>
  | segEnd clifton bridgeSpan |
  segEnd := aSegment segLimit.
  clifton := segEnd - manager bridgeSize. "clifton is where the Avon bridge begins..."
  bridgeSpan := nextSegmentOrNil
  ifNil: [manager bridgeSize]
  ifNotNil: [nextSegmentOrNil segStart - segEnd + manager bridgeSize].
+ self assert: bridgeSpan >= 0.
  manager initSegmentBridgeWithBytes: bridgeSpan at: clifton.
  "the revised bridge should get us to the new segment"
  self assert: (manager addressAfter: (manager objectStartingAt: clifton))
  = (nextSegmentOrNil
  ifNil: [aSegment segLimit]
  ifNotNil: [nextSegmentOrNil segStart])
  !

Item was added:
+ ----- Method: SpurSegmentManager>>printSegmentAddresses (in category 'simulation only') -----
+ printSegmentAddresses
+ <doNotGenerate>
+ "Convenient when debugging segment overlap"
+ Transcript show: 'Seg addresses: '; cr.
+ 0 to: numSegments - 1 do:
+ [:i|
+ Transcript
+ show: (segments at: i) segStart;
+ show: ' -> ';
+ show: (segments at: i) segLimit;
+ show: ' ; '].
+ Transcript cr.!

Item was added:
+ ----- Method: SpurSegmentManager>>segmentOverlap (in category 'growing/shrinking memory') -----
+ segmentOverlap
+ "Answers true if a segment overlaps with another one."
+ 0 to: numSegments - 1 do:
+ [:i| | starti endi |
+ starti := (segments at: i) segStart.
+ endi := (segments at: i) segLimit.
+ 0 to: numSegments - 1 do:
+ [:j| | startj endj |
+ startj := (segments at: j) segStart.
+ endj := (segments at: j) segLimit.
+ i = j ifFalse:
+ [(starti < startj or: [starti >= endj])
+ ifFalse:
+ [self cCode: '' inSmalltalk: [self error: 'segment overlap ' , i printString , ' and ' , j printString].
+ ^true].
+ (endi <= startj or: [endi >= endj])
+ ifFalse: [self cCode: '' inSmalltalk: [self error: 'segment overlap ' , i printString , ' and ' , j printString].
+ ^true].
+ "self printSegmentAddresses"
+ ]]].
+ ^false!

Item was changed:
  ----- Method: VMClass class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  "Falsify the `what type of VM is this?' flags that are defined in the various interp.h files.
  Subclass implementations need to include a super initializeMiscConstants"
 
  | omc |
  VMBIGENDIAN class. "Mention this for the benefit of CCodeGenerator>>emitCConstantsOn:"
  SPURVM := STACKVM := COGVM := COGMTVM := false.
 
  initializationOptions ifNil: [self initializationOptions: Dictionary new].
  omc := initializationOptions at: #ObjectMemory ifAbsent: nil.
  (omc isNil and: [self defaultObjectMemoryClass notNil]) ifTrue:
  [omc := initializationOptions at: #ObjectMemory put: self defaultObjectMemoryClass name].
  initializationOptions
  at: #SqueakV3ObjectMemory "the good ole default"
  ifAbsentPut: (omc
  ifNil: [true]
  ifNotNil: [(Smalltalk at: omc) includesBehavior: ObjectMemory]);
  at: #SpurObjectMemory "the new contender"
  ifAbsentPut: (omc
  ifNil: [false]
  ifNotNil: [(Smalltalk at: omc) includesBehavior: SpurMemoryManager]).
 
  "Use ifAbsentPut: so that they will get copied back to the
  VMMaker's options and dead code will likely be eliminated."
  PharoVM := initializationOptions at: #PharoVM ifAbsentPut: [false].
  NewspeakVM := initializationOptions at: #NewspeakVM ifAbsentPut: [false].
  SistaVM := initializationOptions at: #SistaVM ifAbsentPut: [false].
  TempVectReadBarrier := initializationOptions at: #TempVectReadBarrier ifAbsentPut: [false].
  LowcodeVM := initializationOptions at: #LowcodeVM ifAbsentPut: [false].
  MULTIPLEBYTECODESETS := initializationOptions at: #MULTIPLEBYTECODESETS ifAbsentPut: [false].
 
  "These must be set only if specified, not defaulted, because they are set on the command line or in include files."
  initializationOptions
  at: #VMBIGENDIAN ifPresent: [:value| VMBIGENDIAN := value];
  at: #ObjectMemory ifPresent: [:value| SPURVM := value beginsWith: 'Spur'];
  at: #STACKVM ifPresent: [:value| STACKVM := value];
  at: #COGVM ifPresent: [:value| COGVM := initializationOptions at: #COGVM];
  at: #COGMTVM ifPresent: [:value| COGMTVM := initializationOptions at: #COGMTVM].
 
  "consistency checks"
  (TempVectReadBarrier and: [SPURVM not]) ifTrue: [self error: 'read barrier works with spur VM only...'].
  (SistaVM and: [SPURVM not]) ifTrue: [self error: 'Sista VM works with spur VM only...'].
+ ((initializationOptions at: #compactorClass ifAbsent: []) = #SpurSelectiveCompactor and: [TempVectReadBarrier not]) ifTrue: [self error: 'Selective compactor requires read barrier'].
- ((initializationOptions at: #compactorClass) = #SpurSelectiveCompactor and: [TempVectReadBarrier not]) ifTrue: [self error: 'Selective compactor requires read barrier'].
 
  "And not these; they're compile-time"
  IMMUTABILITY := initializationOptions at: #IMMUTABILITY ifAbsent: [SPURVM] "Default as enabled for Spur VMs"!