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

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

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

Name: VMMaker.oscog-eem.510
Author: eem
Time: 13 November 2013, 1:55:19.338 pm
UUID: 70117c0d-28a7-4703-a044-cab26cfffe83
Ancestors: VMMaker.oscog-eem.509

Reduce C compilation warnings for the Spur Stack VM.

Fix bug in SpurMemMgr>>countMarkedAndUnmarkdObjects:.

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

Item was changed:
  ----- Method: CoInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
  followForwardingPointersInStackZone: theBecomeEffectsFlags
  "Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
  The read-barrier is minimised by arranging that forwarding pointers will fail a method cache probe,
  since notionally objects' internals are accessed only via sending messages to them (the exception
  is primitives that access the internals of the non-receiver argument(s).
  To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and methods
  in the stack zone and follow any forwarded ones.  This is of course way cheaper than scanning all
  of memory as in the old become."
  | theIPPtr |
  <inline: false>
  <var: #thePage type: #'StackPage *'>
  <var: #theSP type: #'char *'>
  <var: #theFP type: #'char *'>
  <var: #callerFP type: #'char *'>
+ <var: #theIPPtr type: #usqInt>
- <var: #theIPPtr type: #'char *'>
 
  (theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  [(objectMemory isForwarded: method) ifTrue:
  [theIPPtr := instructionPointer - method.
  method := objectMemory followForwarded: method.
  instructionPointer := method + theIPPtr].
  (objectMemory isForwarded: newMethod) ifTrue:
  [newMethod := objectMemory followForwarded: newMethod]].
 
  self assert: stackPage ~= 0.
  0 to: numStackPages - 1 do:
  [:i| | thePage theSP theFP callerFP oop offset |
  thePage := stackPages stackPageAt: i.
  thePage isFree ifFalse:
  [theSP := thePage headSP.
  theFP := thePage  headFP.
  "Skip the instruction pointer on top of stack of inactive pages."
  thePage = stackPage
  ifTrue: [theIPPtr := 0]
  ifFalse:
+ [theIPPtr := theSP asUnsignedInteger.
- [theIPPtr := theSP.
  theSP := theSP + BytesPerWord].
  [self assert: (thePage addressIsInPage: theFP).
+  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
-  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
   offset := theFP + (self frameStackedReceiverOffset: theFP).
   oop := stackPages longAt: offset.
   ((objectMemory isNonImmediate: oop)
    and: [(objectMemory isForwarded: oop)]) ifTrue:
  [stackPages
  longAt: offset
  put: (objectMemory followForwarded: oop)].
   ((self frameHasContext: theFP)
    and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
  [stackPages
  longAt: theFP + FoxThisContext
  put: (objectMemory followForwarded: (self frameContext: theFP))].
  (self isMachineCodeFrame: theFP)
  ifTrue:
  [oop := stackPages longAt: theFP + FoxIFReceiver.
  ((objectMemory isNonImmediate: oop)
   and: [(objectMemory isForwarded: oop)]) ifTrue:
  [stackPages
  longAt: theFP + FoxIFReceiver
  put: (objectMemory followForwarded: oop)].
  self assert: (objectMemory isForwarded: (self frameMethodObject: theFP)) not]
  ifFalse:
  [oop := stackPages longAt: theFP + FoxIFReceiver.
  ((objectMemory isNonImmediate: oop)
   and: [(objectMemory isForwarded: oop)]) ifTrue:
  [stackPages
  longAt: theFP + FoxIFReceiver
  put: (objectMemory followForwarded: oop)].
  oop := self frameMethod: theFP.
  (objectMemory isForwarded: oop) ifTrue:
  [| delta |
  delta := (objectMemory followForwarded: oop) - oop.
  (theIPPtr ~= 0
   and: [(stackPages longAt: theIPPtr) > (self frameMethod: theFP)]) ifTrue:
  [stackPages
  longAt: theIPPtr
  put: (stackPages longAt: theIPPtr) + delta].
  stackPages
  longAt: theFP + FoxIFSavedIP
  put: (stackPages longAt: theFP + FoxIFSavedIP) + delta.
  stackPages
  longAt: theFP + FoxMethod
  put: (objectMemory followForwarded: oop)]].
   self followNecessaryForwardingInMethod: (self frameMethod: theFP).
   (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ [theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
- [theIPPtr := theFP + FoxCallerSavedIP.
  theFP := callerFP]]]!

Item was changed:
  ----- Method: ObjectMemory>>readHeapFromImageFile:dataBytes: (in category 'image save/restore') -----
  readHeapFromImageFile: f dataBytes: numBytes
  "Read numBytes of image data from f into memory at memoryBaseForImageRead.
  Answer the number of bytes written."
+ <var: #f type: #sqImageFile>
  ^self cCode:
  [self
  sq: (self pointerForOop: self memoryBaseForImageRead)
  Image: (self sizeof: #char)
  File: numBytes
  Read: f]
  inSmalltalk:
  [(f readInto: memory
  startingAt: self memoryBaseForImageRead // 4 + 1
  count: numBytes // 4)
  * 4]!

Item was changed:
  ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  self declareCAsOop: #( memory freeStart scavengeThreshold newSpaceLimit pastSpaceStart
  lowSpaceThreshold freeOldSpaceStart startOfMemory endOfMemory sortedFreeChunks)
  in: aCCodeGenerator.
  self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs'])
  in: aCCodeGenerator.
  aCCodeGenerator
  var: #freeListsMask type: #usqInt;
  var: #freeLists type: #'sqInt *';
  var: #classTableBitmap type: #'unsigned char *';
+ var: #objStackInvalidBecause type: #'char *';
  var: #highestObjects type: #SpurCircularBuffer;
  var: #unscannedEphemerons type: #SpurContiguousObjStack.
  aCCodeGenerator
  var: #remapBuffer
  declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
  aCCodeGenerator
  var: #extraRoots
+ declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'!
- declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.!

Item was changed:
  ----- Method: SpurMemoryManager>>countMarkedAndUnmarkdObjects: (in category 'debug support') -----
  countMarkedAndUnmarkdObjects: printFlags
  "print the count of marked and unmarked objects.
  In addition if 1 is set in printFlags, short-print marked objects,
  and/or if 2 is set, short-print unmarked obejcts."
  <api>
  | nm nu |
  nm := nu := 0.
  self allObjectsDo:
  [:o|
  (self isMarked: o)
  ifTrue:
  [nm := nm + 1.
  (printFlags anyMask: 1) ifTrue:
  [coInterpreter shortPrintOop: o]]
  ifFalse:
  [nu := nu + 1.
  (printFlags anyMask: 2) ifTrue:
  [coInterpreter shortPrintOop: o]]].
+ self print: 'n marked: '; printNum: nm; cr.
+ self print: 'n unmarked: '; printNum: nu; cr!
- self print: 'n marked: '; print: nm; cr.
- self print: 'n unmarked: '; print: nu; cr!

Item was changed:
  ----- Method: SpurMemoryManager>>isValidObjStackPage:myIndex: (in category 'obj stacks') -----
  isValidObjStackPage: objStackPage myIndex: myx
  "Just check the page itself."
  <inline: false>
  (self classIndexOf: objStackPage) = self wordSizeClassIndexPun ifFalse:
+ [objStackInvalidBecause := 'wrong class index'.
- [objStackInvalidBecause := 'wong class index'.
  invalidObjStackPage := objStackPage.
  ^false].
  (self formatOf: objStackPage) = self wordIndexableFormat ifFalse:
+ [objStackInvalidBecause := 'wrong format'.
- [objStackInvalidBecause := 'wong format'.
  invalidObjStackPage := objStackPage.
  ^false].
  (self numSlotsOfAny: objStackPage) = ObjStackPageSlots ifFalse:
+ [objStackInvalidBecause := 'wrong num slots'.
- [objStackInvalidBecause := 'wong num slots'.
  invalidObjStackPage := objStackPage.
  ^false].
  myx = (self fetchPointer: ObjStackMyx ofObject: objStackPage) ifFalse:
+ [objStackInvalidBecause := 'wrong myx'.
- [objStackInvalidBecause := 'wong myx'.
  invalidObjStackPage := objStackPage.
  ^false].
  (marking and: [(self isMarked: objStackPage) not]) ifTrue:
  [objStackInvalidBecause := 'marking but page is unmarked'.
  invalidObjStackPage := objStackPage.
  ^false].
  ^true!

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 *'>
  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: (segments at: 0) segLimit asVoidPointer
  AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize]
  inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil:
  [:segAddress| | newSegIndex newSeg |
  newSegIndex := self insertSegmentFor: segAddress asUnsignedLong.
  newSeg := self addressOf: (segments at: newSegIndex).
  newSeg
+ segStart: segAddress asUnsignedLong;
- segStart: segAddress;
  segSize: allocatedSize.
  self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg.
  self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse:
  [self addressOf: (segments at: newSegIndex + 1)]).
  "and add the new free chunk to the free list; done here
   instead of in assimilateNewSegment: for the assert"
  manager addFreeChunkWithBytes: allocatedSize - manager bridgeSize at: newSeg segStart.
  self assert: (manager addressAfter: (manager objectStartingAt: newSeg segStart))
  = (newSeg segLimit - manager bridgeSize).
+ "test isInMemory:"
+ 0 to: numSegments - 1 do:
+ [:i|
+ self assert: (manager isInMemory: (segments at: i) segStart).
+ self assert: (manager isInMemory: (segments at: i) segLimit - manager wordSize).
+ self assert: (manager isInMemory: (segments at: i) segLimit) not.
+ (i between: 1 and: numSegments - 2) ifTrue:
+ [self assert: (manager isInMemory: (segments at: i) segStart - manager wordSize) not]].
  ^newSeg].
  ^nil!

Item was changed:
  ----- Method: SpurSegmentManager>>readHeapFromImageFile:dataBytes: (in category 'snapshot') -----
  readHeapFromImageFile: f dataBytes: numBytes
  "Read numBytes of image data from f into memory at memoryBaseForImageRead.
  Answer the number of bytes written.  In addition, read each segment, build up the
  segment info, while eliminating the bridge objects that end each segment and
  give the size of the subsequent segment."
+ <var: #f type: #sqImageFile>
  <inline: false>
  | bytesRead totalBytesRead bridge nextSegmentSize oldBase newBase segInfo bridgeSpan |
  <var: 'segInfo' type: 'SpurSegmentInfo *'>
  self allocateOrExtendSegmentInfos.
 
  "segment sizes include the two-header-word bridge at the end of each segment."
  numSegments := totalBytesRead := 0.
  oldBase := 0. "N.B. still must be adjusted by oldBaseAddr."
  newBase := manager newSpaceLimit.
  nextSegmentSize := firstSegmentSize.
  bridge := firstSegmentSize + manager newSpaceLimit - manager baseHeaderSize.
  [segInfo := self addressOf: (segments at: numSegments).
  segInfo
  segStart: oldBase; "N.B. still must be adjusted by oldBaseAddr."
  segSize: nextSegmentSize;
  swizzle: newBase - oldBase. "N.B. still must be adjusted by oldBaseAddr."
  bytesRead := self readHeapFrom: f at: newBase dataBytes: nextSegmentSize.
  bytesRead > 0 ifTrue:
  [totalBytesRead := totalBytesRead + bytesRead].
  bytesRead ~= nextSegmentSize ifTrue:
  [^totalBytesRead].
  numSegments := numSegments + 1.
  bridgeSpan := manager bytesPerSlot * (manager rawOverflowSlotsOf: bridge).
  oldBase := oldBase + nextSegmentSize + bridgeSpan.
  newBase := newBase + nextSegmentSize - manager bridgeSize.
  nextSegmentSize := manager longLongAt: bridge.
  nextSegmentSize ~= 0] whileTrue:
  [bridge := bridge - manager bridgeSize + nextSegmentSize].
  "newBase should point just past the last bridge. all others should have been eliminated."
  self assert: newBase - manager newSpaceLimit
  = (totalBytesRead - (numSegments * manager bridgeSize)).
  "set freeOldSpaceStart now for adjustAllOopsBy:"
  manager setFreeOldSpaceStart: newBase.
  ^totalBytesRead!

Item was changed:
  ----- Method: SpurSegmentManager>>writeSegment:nextSegmentSize:toFile: (in category 'snapshot') -----
  writeSegment: aSpurSegmentInfo nextSegmentSize: nextSegSize toFile: aBinaryStream
  <var: 'aSpurSegmentInfo' type: #'SpurSegmentInfo *'>
  <var: 'aBinaryStream' type: #'FILE *'>
  | bridge savedHeader nWritten |
  <var: 'savedHeader' type: #usqLong>
  bridge := aSpurSegmentInfo segLimit - manager baseHeaderSize.
  "last seg may be beyond endOfMemory/freeOldSpaceStart"
  self assert: ((manager isValidSegmentBridge: bridge) or: [nextSegSize = 0]).
  savedHeader := manager longLongAt: bridge.
  manager longLongAt: bridge put: nextSegSize.
  nWritten := self cCode:
  [self
+ sq: aSpurSegmentInfo segStart asVoidPointer
- sq: aSpurSegmentInfo segStart
  Image: 1
  File: aSpurSegmentInfo segSize
  Write: aBinaryStream]
  inSmalltalk:
  [aBinaryStream
  next: aSpurSegmentInfo segSize / 4
  putAll: manager memory
  startingAt: aSpurSegmentInfo segStart / 4 + 1.
  aSpurSegmentInfo segSize].
  manager longLongAt: bridge put: savedHeader.
  ^nWritten!

Item was changed:
  ----- Method: StackInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
  followForwardingPointersInStackZone: theBecomeEffectsFlags
  "Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
  The read-barrier is minimised by arranging that forwarding pointers will fail a method cache probe,
  since notionally objects' internals are accessed only via sending messages to them (the exception
  is primitives that access the internals of the non-receiver argument(s).
  To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and methods
  in the stack zone and follow any forwarded ones.  This is of course way cheaper than scanning all
  of memory as in the old become."
  | theIPPtr |
  <inline: false>
  <var: #thePage type: #'StackPage *'>
  <var: #theSP type: #'char *'>
  <var: #theFP type: #'char *'>
  <var: #callerFP type: #'char *'>
+ <var: #theIPPtr type: #usqInt>
- <var: #theIPPtr type: #'char *'>
 
  (theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  [(objectMemory isForwarded: method) ifTrue:
  [theIPPtr := instructionPointer - method.
  method := objectMemory followForwarded: method.
  instructionPointer := method + theIPPtr].
  (objectMemory isForwarded: newMethod) ifTrue:
  [newMethod := objectMemory followForwarded: newMethod]].
 
  self assert: stackPage ~= 0.
  0 to: numStackPages - 1 do:
  [:i| | thePage theSP theFP callerFP theIP oop |
  thePage := stackPages stackPageAt: i.
  thePage isFree ifFalse:
  [theSP := thePage headSP.
  theFP := thePage  headFP.
  "Skip the instruction pointer on top of stack of inactive pages."
  thePage = stackPage
  ifTrue: [theIPPtr := 0]
  ifFalse:
+ [theIPPtr := theSP asUnsignedInteger.
- [theIPPtr := theSP.
  theSP := theSP + BytesPerWord].
  [self assert: (thePage addressIsInPage: theFP).
+  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
-  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
   oop := stackPages longAt: theFP + FoxReceiver.
   ((objectMemory isNonImmediate: oop)
    and: [(objectMemory isForwarded: oop)]) ifTrue:
  [stackPages
  longAt: theFP + FoxReceiver
  put: (objectMemory followForwarded: oop)].
+  theIP := (theFP + (self frameStackedReceiverOffset: theFP)) asUnsignedInteger. "reuse theIP; its just an offset here"
-  theIP := theFP + (self frameStackedReceiverOffset: theFP). "reuse theIP; its just an offset here"
   oop := stackPages longAt: theIP.
   ((objectMemory isNonImmediate: oop)
    and: [(objectMemory isForwarded: oop)]) ifTrue:
  [stackPages
  longAt: theIP
  put: (objectMemory followForwarded: oop)].
   ((self frameHasContext: theFP)
    and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
  [stackPages
  longAt: theFP + FoxThisContext
  put: (objectMemory followForwarded: (self frameContext: theFP))].
   oop := self frameMethod: theFP.
   (objectMemory isForwarded: oop) ifTrue:
  [| delta |
  theIPPtr ~= 0 ifTrue:
  [self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
  delta := (objectMemory followForwarded: oop) - oop.
  stackPages
  longAt: theIPPtr
  put: (stackPages longAt: theIPPtr) + delta].
  stackPages
  longAt: theFP + FoxMethod
  put: (objectMemory followForwarded: oop)].
   self followNecessaryForwardingInMethod: (self frameMethod: theFP).
   (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ [theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
- [theIPPtr := theFP + FoxCallerSavedIP.
  theFP := callerFP]]]!

Item was changed:
  ----- Method: StackInterpreter>>printFrameThing:andFrame:at: (in category 'debug printing') -----
  printFrameThing: name andFrame: theFP at: address
  <var: #theFP type: #'char *'>
  | it len |
  <inline: false>
  <var: #name type: #'char *'>
  <var: #address type: #'char *'>
  it := stackPages longAt: address.
  self printHexPtr: address;
  printChar: $:.
  len := self strlen: name.
  1 to: 12 - len do: [:i| self space].
  self print: name;
  print: ': ';
  printHex: it.
  it ~= 0 ifTrue:
  [self printChar: $=.
  it = objectMemory nilObject
  ifTrue: [self print: 'nil']
  ifFalse:
  [self printNum: it]].
+ self print: ' frame: '; printHexPtr: theFP; cr!
- self print: ' frame: '; printHex: theFP; cr!

Item was changed:
  ----- Method: StackInterpreter>>printStackCallStack (in category 'debug printing') -----
  printStackCallStack
  <doNotGenerate>
+ self printStackCallStackOf: localFP!
- | theFP context |
- theFP := localFP.
- [context := self shortReversePrintFrameAndCallers: theFP.
- ((self isMarriedOrWidowedContext: context)
-  and: [self checkIsStillMarriedContext: context currentFP: localFP]) ifFalse:
- [^nil].
- theFP := self frameOfMarriedContext: context] repeat!

Item was added:
+ ----- Method: StackInterpreter>>printStackCallStackOf: (in category 'debug printing') -----
+ printStackCallStackOf: aFramePointer
+ <var: #aFramePointer type: #'char *'>
+ <api>
+ | theFP context |
+ <var: #theFP type: #'char *'>
+ theFP := aFramePointer.
+ [context := self shortReversePrintFrameAndCallers: theFP.
+ ((self isMarriedOrWidowedContext: context)
+  and:
+ [theFP := self frameOfMarriedContext: context.
+ self checkIsStillMarriedContext: context currentFP: theFP]) ifFalse:
+ [^nil]] repeat!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintOop: (in category 'debug printing') -----
  shortPrintOop: oop
  <inline: false>
  self printHexnp: oop.
  (objectMemory isImmediate: oop) ifTrue:
  [(objectMemory isImmediateCharacter: oop) ifTrue:
  [^self
+ cCode: 'printf("=$%ld ($%lc)\n", (long)characterValueOf(oop), (wint_t)characterValueOf(oop))'
- cCode: 'printf("=$%ld ($%c)\n", (long)characterValueOf(oop), (long)characterValueOf(oop))'
  inSmalltalk: [self print: (self shortPrint: oop); cr]].
  ^self
  cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
  inSmalltalk: [self print: (self shortPrint: oop); cr]].
  (objectMemory addressCouldBeObj: oop) ifFalse:
  [self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  ifTrue: [' is misaligned']
  ifFalse: [' is not on the heap']); cr.
  ^nil].
  ((objectMemory isFreeObject: oop)
  or: [objectMemory isForwarded: oop]) ifTrue:
  [^self printOop: oop].
  self print: ': a(n) '.
  self printNameOfClass: (objectMemory fetchClassOfNonImm: oop) count: 5.
  self cr!